Creating Compressed (Zipped) Folder using Delphi - delphi

Can I create Windows XP's Compressed (Zipped) Folder using Delphi?

If you are using Delphi X2, just use TZipFile from System.Zip:
To Zip a folder, use:
TZipFile.ZipDirectoryContents('ZipFile.zip', 'C:\Zip\this\right\now');
To Zip files, use:
Zip := TZipFile.Create;
try
Zip.Open('ZipFile.zip', zmWrite);
Zip.Add('FileToBeZipped.txt');
Zip.Add('ThisWillBeCompressedAgainForSureAndBecomeSmaller.zip');
finally
Zip.Free;
end

According to a thread in eggheadcafe, you can use CreateFile Function with FILE_FLAG_BACKUP_SEMANTICS to create a Compressed Folder.
For shell extensions route, take a look at Using Windows XP "Compressed Folder" shell extension to work with .zip files by Namespace Edanmo, which is written in VB.
I just found the similar question asked on C++. Take a look at Creating a ZIP file on Windows (XP/2003) in C/C++. I have a feeling the easiest route is buying ZipForge. See Zip a file in Delphi code sample.

Some time ago, I've tried all of the Delphi compression libraries that I could find, and eventually I ended up using KaZip by Kiril Antonov.
My requirements were:
Free;
Open source;
Native Delphi code;
No external dependencies (dll, exe). My most important requirement;
Small memory footprint;
Easy to use;
I use it mainly to turn .kml files into .kmz, and it does that amazingly fast.
Here's an example of how I use it:
uses
KaZip;
...
// replaces a .kml file with a .kmz file
procedure KmlToKmz(const aFileName: string);
var
FS: TFileStream;
KaZip:TKaZip;
KmzFileName:TFileName;
begin
KmzFileName := ChangeFileExt(aFileName, '.kmz');
KaZip := TKaZip.Create(nil);
try
// create an empty zipfile with .kmz extension:
FS := TFileStream.Create(KmzFileName, fmOpenReadWrite or FmCreate);
try
KaZip.CreateZip(FS);
finally
FS.Free;
end;
KaZip.Open(KmzFileName); // Open the new .kmz zipfile
KaZip.Entries.AddFile(aFileName); // add the .kml
KaZip.Close;
DeleteFile(aFileName); // delete the .kml
finally
KaZip.Free;
end;
end;

Take a look at this OpenSource SynZip unit. It's even faster for decompression than the default unit shipped with Delphi, and it will generate a smaller exe (crc tables are created at startup).
No external dll is needed. Works from Delphi 6 up to XE. No problem with Unicode version of Delphi. All in a single unit.
I just made some changes to handle Unicode file names inside Zip content, not only Win-Ansi charset but any Unicode chars. Feedback is welcome.

You could use TurboPower Abbrevia which is now open source.

A "zipped" folder in Windows is nothing more than a .ZIP file compressed using any standard zip library. Compressed folders are a different animal and require an NTFS disk format.
For the "Zip" file, I strongly suggest the Turbo Power Abbrevia, which is open source and works well. You might want to check this alternate site if your using Delphi 2009 as it might be a more recent copy.
If your wanting to use the compressed folders option, you will need to modify the directory flags on the directory handle. This will only impact NEW files added to that directory and will not automatically compress existing files. If you have an existing directory you are trying to compress, then rename each existing file, and load and save it back to the original name deleting the original file when complete with each one. Yozey had a good link to the MSDN documentation. Just remember that this only works with NTFS formatted disks, so you will need to add a check for that in your code.

You can use some command line version of any compressor like 7zip and do the task using ShellExecute, or you can use a free or comercial component like anyone of these.
I had used ZipMaster and it behaves very well for my purpose. I don't know what are your size, space and performance requirements.

Take a look at these:
File Compression
FSCTL_SET_COMPRESSION

The TZipFile.ZipDirectoryContents method did not work for me, so I created my own implementation using TZipFile.add(). I am posting it here if anyone needs it.
procedure CreateZipOfDirectory(directory: string);
var
zip: TZipFile;
Arr: tarray<string>;
str: string;
function GetAllFilesInDir(const Dir: string): tarray<string>;
var
Search: TSearchRec;
procedure addAll(arr: tarray<string>; parent: string);
var
tmp: string;
begin
for tmp in arr do
begin
setlength(result, length(result) + 1);
result[length(result) - 1] := IncludeTrailingBackslash(parent) + tmp;
end;
end;
begin
setlength(result, 0);
if FindFirst(IncludeTrailingBackslash(Dir) + '*.*', faAnyFile or faDirectory, Search) = 0 then
try
repeat
if (Search.Attr and faDirectory) = 0 then
begin
setlength(result, length(result) + 1);
result[length(result) - 1] := Search.Name;
end
else if (Search.Name <> '..') and (Search.Name <> '.') then
addAll(GetAllFilesInDir(IncludeTrailingBackslash(Dir) + Search.Name), Search.Name);
until FindNext(Search) <> 0;
finally
FindClose(Search);
end;
end;
begin
Zip := TZipFile.Create;
try
Zip.Open('Foo.zip', zmWrite);
arr := GetAllFilesInDir(directory); // The Delphi TZipFile.ZipDirectoryContents does not work properly, so let's create our own.
for str in arr do
zip.Add(directory + str, str); // Add the second parameter to make sure that the file structure is preserved.
finally
zip.Free;
end;
end;

Related

Memo and create file and folder?

I'm new to Delphi and i'm a french user so sorry for my bad english...
So it is possible to create a file written in TMemo?
test.txt
dir1/dir2/text.txt
dir3/
My TMemo there are 3 lines, so I would like to take the first line and create the file test.txt in the current directory ..
2nd line: create a folder
3rd line: create a folder again+files.txt
etc ...
I think to use mkdir or ForceDirectories to create Directory and files? etc...
So my conclusion was to automate it.
You can help me please?
a small image so you can see:
With Program and on ButtonClick event
If I have understood the question correctly, this will
Create an empty text file in the application directory with the filename as per Memo Line 1
Create Folders as per Memo Line 2 and in the "base directory" per the edit
Create a Folder and empty TextFile as per Memo Line 3 again in the "base directory"
procedure TForm1.Button1Click(Sender: TObject);
var
Path: String;
F: TextFile;
begin
// Create File in current directory
Path := ExtractFilePath(ParamStr(0)) + Memo1.Lines.Strings[0];
if not FileExists(Path) then
begin
AssignFile(F, Path);
Rewrite(F);
//Writeln(F, 'text to write to file');
CloseFile(F);
end;
// Create Directories
Path := IncludeTrailingPathDelimiter(edPath.Text) + Memo1.Lines.Strings[1];
if not DirectoryExists(Path) then
ForceDirectories(Path);
// Create Directory and File
Path := IncludeTrailingPathDelimiter(edPath.Text) + Memo1.Lines.Strings[2];
if not DirectoryExists(ExtractFilePath(Path)) then
ForceDirectories(ExtractFilePath(Path));
if not FileExists(Path) then
begin
AssignFile(F, Path);
Rewrite(F);
//Writeln(F, 'text to write to file');
CloseFile(F);
end;
end;
Obviously needs significantly more error checking determining if paths valid and files / directories created etc...
Edit: code in browser so have no idea if it works but really is a simple thing to do.
You should only use a TMemo if you want to display the data before you save it, because the task of a visual control is to display something. But if you only want to use the Items propery of the TMemo for collecting strings and then save them to file you should use a TStringList instead:
var
i: Integer;
sl: TStringList;
begin
sl := TStringList.Create;
try
for i := 0 to Memo1.Lines.Count-1 do
sl.Add(Memo1.Lines[i]);
sl.SaveToFile(sl[1]);
finally
sl.free;
end;
end;
You may also like this thread: http://www.tek-tips.com/viewthread.cfm?qid=678231
EDIT2:
Memo1.Lines.SaveToFile(edit1.text + Memo1.Lines[0]);
Provided that Edit Control is named Edit1 and has your base path and first line of the TMemo has the file name. The other bit you need is an Event and by that I mean if you doubleclick your TMemo instance it will be the event that will start the cascade for saving the file.
As you see it is very easy and there are other ways such as SaveDialog that can make it much easier still. but hope this answers your question.

With FireMonkey and its cross-platforms, where should I store my application data?

Usually, with Windows, I save my application's data in the user folder (%appdata%).
For that, I use the function ExpandEnvironmentStrings which is linked to Windows to get the folder I need, and I store inside a subfolder my inifile.
Is there any best practice to manage that and be compliant with all the supported platforms (Windows 32b, 64b & Mac)?
I successfully tested like that:
procedure TfrmMain.SaveSettings;
var
fnINI: TFileName;
ini : TIniFile;
begin
fnINI := IncludeTrailingPathDelimiter(GetHomePath) + IncludeTrailingPathDelimiter(APP_NAME) + ChangeFileExt(APP_NAME, '.ini');
if ForceDirectories(ExtractFilePath(fnINI)) then
begin
ini := TIniFile.Create(fnINI);
try
ini.WriteString(INI_CONNECTION, INI_IP, edtIP.Text);
finally
ini.Free;
end;
end;
end;
Haven't tried XE2 but probably you could use SysUtils.GetHomePath. Also check IOUtils where you can find useful records (TFile, TPath, TDirectory) for managing files, paths and directories. They should support different platforms.

Create and/or Write to a file

I feel like this should be easy, but google is totally failing me at the moment. I want to open a file, or create it if it doesn't exist, and write to it.
The following
AssignFile(logFile, 'Test.txt');
Append(logFile);
throws an error on the second line when the file doesn't exist yet, which I assume is expected. But I'm really failing at finding out how to a) test if the file exists and b) create it when needed.
FYI, working in Delphi XE.
You can use the FileExists function and then use Append if exist or Rewrite if not.
AssignFile(logFile, 'Test.txt');
if FileExists('test.txt') then
Append(logFile)
else
Rewrite(logFile);
//do your stuff
CloseFile(logFile);
Any solution that uses FileExists to choose how to open the file has a race condition. If the file's existence changes between the time you test it and the time you attempt to open the file, your program will fail. Delphi doesn't provide any way to solve that problem with its native file I/O routines.
If your Delphi version is new enough to offer it, you can use the TFile.Open with the fmOpenOrCreate open mode, which does exactly what you want; it returns a TFileStream.
Otherwise, you can use the Windows API function CreateFile to open your file instead. Set the dwCreationDisposition parameter to OPEN_ALWAYS, which tells it to create the file if it doesn't already exist.
You should be using TFileStream instead. Here's a sample that will create a file if it doesn't exist, or write to it if it does:
var
FS: TFileStream;
sOut: string;
i: Integer;
Flags: Word;
begin
Flags := fmOpenReadWrite;
if not FileExists('D:\Temp\Junkfile.txt') then
Flags := Flags or fmCreate;
FS := TFileStream.Create('D:\Temp\Junkfile.txt', Flags);
try
FS.Position := FS.Size; // Will be 0 if file created, end of text if not
sOut := 'This is test line %d'#13#10;
for i := 1 to 10 do
begin
sOut := Format(sOut, [i]);
FS.Write(sOut[1], Length(sOut) * SizeOf(Char));
end;
finally
FS.Free;
end;
end;
If you are just doing something simple, the IOUtils Unit is a lot easier. It has a lot of utilities for writing to files.
e.g.
procedure WriteAllText(const Path: string; const Contents: string);
overload; static;
Creates a new file, writes the specified string to the file, and then
closes the file. If the target file already exists, it is overwritten.
You can also use the load/save feature in a TStringList to solve your problem.
This might be a bad solution, because the whole file will be loaded into memory, modified in memory and then saved to back to disk. (As opposed to your solution where you just write directly to the file). It's obviously a bad solution for multiuser situations.
But this approach is OK for smaller files, and it is easy to work with and easy understand.
const
FileName = 'test.txt';
var
strList: TStringList;
begin
strList := TStringList.Create;
try
if FileExists(FileName) then
strList.LoadFromFile(FileName);
strList.Add('My new line');
strList.SaveToFile(FileName);
finally
strList.Free;
end;
end;

How can I get this File Writing code to work with Unicode (Delphi)

I had some code before I moved to Unicode and Delphi 2009 that appended some text to a log file a line at a time:
procedure AppendToLogFile(S: string);
// this function adds our log line to our shared log file
// Doing it this way allows Wordpad to open it at the same time.
var F, C1 : dword;
begin
if LogFileName <> '' then begin
F := CreateFileA(Pchar(LogFileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_ALWAYS, 0, 0);
if F <> 0 then begin
SetFilePointer(F, 0, nil, FILE_END);
S := S + #13#10;
WriteFile(F, Pchar(S)^, Length(S), C1, nil);
CloseHandle(F);
end;
end;
end;
But CreateFileA and WriteFile are binary file handlers and are not appropriate for Unicode.
I need to get something to do the equivalent under Delphi 2009 and be able to handle Unicode.
The reason why I'm opening and writing and then closing the file for each line is simply so that other programs (such as WordPad) can open the file and read it while the log is being written.
I have been experimenting with TFileStream and TextWriter but there is very little documentation on them and few examples.
Specifically, I'm not sure if they're appropriate for this constant opening and closing of the file. Also I'm not sure if they can make the file available for reading while they have it opened for writing.
Does anyone know of a how I can do this in Delphi 2009 or later?
Conclusion:
Ryan's answer was the simplest and the one that led me to my solution. With his solution, you also have to write the BOM and convert the string to UTF8 (as in my comment to his answer) and then that worked just fine.
But then I went one step further and investigated TStreamWriter. That is the equivalent of the .NET function of the same name. It understands Unicode and provides very clean code.
My final code is:
procedure AppendToLogFile(S: string);
// this function adds our log line to our shared log file
// Doing it this way allows Wordpad to open it at the same time.
var F: TStreamWriter;
begin
if LogFileName <> '' then begin
F := TStreamWriter.Create(LogFileName, true, TEncoding.UTF8);
try
F.WriteLine(S);
finally
F.Free;
end;
end;
Finally, the other aspect I discovered is if you are appending a lot of lines (e.g. 1000 or more), then the appending to the file takes longer and longer and it becomes quite inefficient.
So I ended up not recreating and freeing the LogFile each time. Instead I keep it open and then it is very fast. The only thing I can't seem to do is allow viewing of the file with notepad while it is being created.
For logging purposes why use Streams at all?
Why not use TextFiles? Here is a very simple example of one of my logging routines.
procedure LogToFile(Data:string);
var
wLogFile: TextFile;
begin
AssignFile(wLogFile, 'C:\MyTextFile.Log');
{$I-}
if FileExists('C:\MyTextFile.Log') then
Append(wLogFile)
else
ReWrite(wLogFile);
WriteLn(wLogfile, S);
CloseFile(wLogFile);
{$I+}
IOResult; //Used to clear any possible remaining I/O errors
end;
I actually have a fairly extensive logging unit that uses critical sections for thread safety, can optionally be used for internal logging via the OutputDebugString command as well as logging specified sections of code through the use of sectional identifiers.
If anyone is interested I'll gladly share the code unit here.
Char and string are Wide since D2009. Thus you should use CreateFile instead of CreateFileA!
If you werite the string you shoudl use Length( s ) * sizeof( Char ) as the byte length and not only Length( s ). because of the widechar issue. If you want to write ansi chars, you should define s as AnsiString or UTF8String and use sizeof( AnsiChar ) as a multiplier.
Why are you using the Windows API function instead of TFileStream defined in classes.pas?
Try this little function I whipped up just for you.
procedure AppendToLog(filename,line:String);
var
fs:TFileStream;
ansiline:AnsiString;
amode:Integer;
begin
if not FileExists(filename) then
amode := fmCreate
else
amode := fmOpenReadWrite;
fs := TFileStream.Create(filename,{mode}amode);
try
if (amode<>fmCreate) then
fs.Seek(fs.Size,0); {go to the end, append}
ansiline := AnsiString(line)+AnsiChar(#13)+AnsiChar(#10);
fs.WriteBuffer(PAnsiChar(ansiline)^,Length(ansiline));
finally
fs.Free;
end;
Also, try this UTF8 version:
procedure AppendToLogUTF8(filename, line: UnicodeString);
var
fs: TFileStream;
preamble:TBytes;
outpututf8: RawByteString;
amode: Integer;
begin
if not FileExists(filename) then
amode := fmCreate
else
amode := fmOpenReadWrite;
fs := TFileStream.Create(filename, { mode } amode, fmShareDenyWrite);
{ sharing mode allows read during our writes }
try
{internal Char (UTF16) codepoint, to UTF8 encoding conversion:}
outpututf8 := Utf8Encode(line); // this converts UnicodeString to WideString, sadly.
if (amode = fmCreate) then
begin
preamble := TEncoding.UTF8.GetPreamble;
fs.WriteBuffer( PAnsiChar(preamble)^, Length(preamble));
end
else
begin
fs.Seek(fs.Size, 0); { go to the end, append }
end;
outpututf8 := outpututf8 + AnsiChar(#13) + AnsiChar(#10);
fs.WriteBuffer(PAnsiChar(outpututf8)^, Length(outpututf8));
finally
fs.Free;
end;
end;
If you try to use text file or Object Pascal typed/untyped files in a multithreaded application you gonna have a bad time.
No kidding - the (Object) Pascal standard file I/O uses global variables to set file mode and sharing. If your application runs in more than one thread (or fiber if anyone still use them) using standard file operations could result in access violations and unpredictable behavior.
Since one of the main purposes of logging is debugging a multithreaded application, consider using other means of file I/O: Streams and Windows API.
(And yes, I know it is not really an answer to the original question, but I do not wish to log in - therefor I do not have the reputation score to comment on Ryan J. Mills's practically wrong answer.)

How to delete files matching pattern within a directory

That is, delete all files matching pattern within a given directory
Example, Delete all *.jpg files within DirectoryName
procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteFiles(ExtractFilePath(ParamStr(0)),'*.jpg');
end;
procedure DeleteFiles(APath, AFileSpec: string);
var
lSearchRec:TSearchRec;
lPath:string;
begin
lPath := IncludeTrailingPathDelimiter(APath);
if FindFirst(lPath+AFileSpec,faAnyFile,lSearchRec) = 0 then
begin
try
repeat
SysUtils.DeleteFile(lPath+lSearchRec.Name);
until SysUtils.FindNext(lSearchRec) <> 0;
finally
SysUtils.FindClose(lSearchRec); // Free resources on successful find
end;
end;
end;
In more recent versions of Delphi, you would probably use the classes in System.IOUtils, which are essentially wrapping FindFirst, FindNext etc:
procedure DeleteFilesMatchingPattern(const Directory, Pattern: string);
var FileName: string;
begin
for FileName in TDirectory.GetFiles(Directory, Pattern) do TFile.Delete(FileName);
end;
You can use the SHFileOperation function. The nice thing about using SHFileOperation is you have the option of deleting the files to the recycle bin and you get the normal API animations so the user will know what is going on. The downside is the delete will take a little longer than Jeff's code.
There are several wrappers out there. I use this free wrapper from BP Software. The entire wrapper file is only 220 lines and is easy to read and use. I don't install this as a component. I have found it easier to add this unit to my project and just Create and free the object as needed.
Update: The download link for the BP Software site is no longer valid. There is an older version on the Embarcadero website.
TSHFileOp (1.3.5.1) (3 KB) May
31, 2006 TComponent that is a wrapper
for the SHFileOperation API to copy,
move, rename, or delete (with
recycle-bin support) a file system
object.
The file name parameter for SHFileOperation supports MS DOS style wildcards. So you can use the component like this:
FileOps := TSHFileOp.Create(self);
FileOps.FileList.Add(DirectoryName + '\*.jpg');
FileOps.HWNDHandle := self.Handle;
FileOps.Action := faDelete;
FileOps.SHOptions :=
[ofAllowUndo, ofNoConfirmation, ofFilesOnly, ofSimpleProgress];
FileOps.Execute;
I usually show the "Are you sure" message myself so I always pass the ofNoConfirmation flag so Windows does not ask again.
If you don't want to delete every jpg file or you need to delete from multiple directories you can add full file names or different paths with wild cards to the FileList string list before calling execute.
Here is the MSDN Page for SHFileOperation
Note that SHFileOperation has been replaced by IFileOperation starting with Windows Vista. I have continued to use SHFileOperation on Windows Vista without any problems.

Resources