Blog
All Blog Posts | Next Post | Previous Post
Zip and Unzip files in Delphi without using a 3rd party component
Sunday, December 27, 2009
Using Windows Explorer from time to time to open ZIP files or create ZIP files, I knew that Windows can internally manage ZIP files so it was a matter of searching via what API this functionality is exposed to use it from applications. And yes, it is effectively exposed, albeit in a limited way via OLE automation with Shell.Application. This API makes it fairly easy to zip or unzip a ZIP file. Here is a function for using the API from Delphi to unzip a file. The filter parameter is optional and can be used to extract only files that match the filter condition.const SHCONTCH_NOPROGRESSBOX = 4; SHCONTCH_AUTORENAME = 8; SHCONTCH_RESPONDYESTOALL = 16; SHCONTF_INCLUDEHIDDEN = 128; SHCONTF_FOLDERS = 32; SHCONTF_NONFOLDERS = 64; function ShellUnzip(zipfile, targetfolder: string; filter: string = ''): boolean; var shellobj: variant; srcfldr, destfldr: variant; shellfldritems: variant; begin shellobj := CreateOleObject('Shell.Application'); srcfldr := shellobj.NameSpace(zipfile); destfldr := shellobj.NameSpace(targetfolder); shellfldritems := srcfldr.Items; if (filter <> '') then shellfldritems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS,filter); destfldr.CopyHere(shellfldritems, SHCONTCH_NOPROGRESSBOX or SHCONTCH_RESPONDYESTOALL); end;
To create a ZIP file, the Shell.Application CopyHere() API expects that the ZIP file already exists. It is as such necessary to first create an empty ZIP file. This is fortunately easy and this is also what the proposed Delphi function here does. Another problem with creating a ZIP file is that in this case the CopyHere() function is not blocking. This means that the call to CopyHere() returns immediately and the shell creates threads that perform the actual compressing. This is quite inconvenient if your code needs to do further actions on the compressed file. To workaround this issue, we simply track the number of process threads and wait till all threads created by the shell are terminated. The resulting Delphi code is:
// counts the number of threads in the process function NumProcessThreads: integer; var hsnapshot: THandle; Te32: TTHREADENTRY32; proch: dword; procthreads: integer; begin procthreads := 0; proch := GetCurrentProcessID; hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); Te32.dwSize := sizeof(TTHREADENTRY32); if Thread32First(hSnapShot, Te32) then begin if te32.th32OwnerProcessID = proch then inc(procthreads); while Thread32Next(hSnapShot, Te32) do begin if te32.th32OwnerProcessID = proch then inc(procthreads); end; end; CloseHandle (hSnapShot); Result := procthreads; end; function ShellZip(zipfile, sourcefolder:string; filter: string = ''): boolean; const emptyzip: array[0..23] of byte = (80,75,5,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); var ms: TMemoryStream; shellobj: variant; srcfldr, destfldr: variant; shellfldritems: variant; numt: integer; begin if not FileExists(zipfile) then begin // create a new empty ZIP file ms := TMemoryStream.Create; ms.WriteBuffer(emptyzip, sizeof(emptyzip)); ms.SaveToFile(zipfile); ms.Free; end; numt := NumProcessThreads; shellobj := CreateOleObject('Shell.Application'); srcfldr := shellobj.NameSpace(sourcefolder); destfldr := shellobj.NameSpace(zipfile); shellfldritems := srcfldr.Items; if (filter <> '') then shellfldritems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS,filter); destfldr.CopyHere(shellfldritems, 0); // wait till all shell threads are terminated while NumProcessThreads <> numt do begin sleep(100); end; end;
Bruno Fierens

This blog post has received 15 comments.

uses
Comobj, Windows,Tlhelp32
Then this will complie in 2010... Took a little while to track down, you guys owe me one.....
Huff R

Ruschmeyer Monika

Bruno Fierens

Gabriel Jim

What to do with this exception in Delphi 2007?
Ole

Their solution was to enclose the variable string with brackets e.g. instead of "filter", use "(filter)". Using brackets on all the strings passed as arguments now allows me to use this code in Delphi 7. I hope this info will be useful to others experiencing a similar problem.
Geoff Bacon

The unzip process will use the Local Settings\Temp directory of the users machine to support the process.
It will store a copy of the unzipped file here.
For each unzip session of a particular file it will make a new copy and add it to the temp folder in a new folder called Temporary Directory 1 [your zip file name].
Once the number of copies of the same zip file reaches more than 99 you will get an error when trying to unzip the same file again. It will state that the file already exists. Hence, make sure that your unzipped files are first deleted from the temp directory.
Please do not remark as to why unzip the same file more than 99 times.
Rao B.J.

However, just putting any parameters passed to the shell methods first works OK:
procedure ShellUnzip(const ZipFile, TargetFldr: string);
var
ShellObj: Variant;
...
ZipFileV, TargetFldrV: Variant;
SrcFldr, DestFldr: Variant;
begin
ShellObj := CreateOleObject(''Shell.Application'');
//SrcFldr := shellobj.NameSpace(ZipFile);
// in D2005 SrcFldr will be $000000
// But, this works:
ZipFileV := ZipFile;
SrcFldr := shellobj.NameSpace(ZipFileV);
// do this for all variant parameters
TargetFldrV := TargetFldr;
DestFldr := shellobj.NameSpace(TargetFldrV);
Russell Ryan

Although, thread numbering does not work for me. I choose to check two things: if zipfile size was modified and if it can be open on write (fmOpenWrite or fmShareDenyWrite). If both then the task is finished.
zedth

the Unzip feature working fine if there is no Pasword protect for Zip file. If I had password protect the filter value is passed with to the function. but this doesnt extract the files. i am Using Delphi 7.
Ashok

it works
Amir Farid

Fullerton Michael

To make work procedure use method write by Russell Ryan and this modification:
oshl : variant;
...
...
shellobj := CreateOleObject(''Shell.Application'');
oshl:= CreateOleObject(''WScript.Shell'');
srcfldr := GetNameSpaceObj(sourcefolder);
if not IsValidDispatch(srcfldr) then
raise EInvalidOperation.CreateFmt(''<%s> invalid source'', [sourcefolder]);
destfldr := GetNameSpaceObj_zipfile;
shellfldritems := srcfldr.Items;
Count:= shellfldritems.Count;
if (filter <> '''') then
shellfldritems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS,filter);
destfldr.CopyHere(shellfldritems, 0);
// wait till all shell threads are terminated
Z:= 1;
while oShl.AppActivate(''Compressing...'') = False do
begin
Sleep(100);
while destfldr.Items.Count > 0 do
begin
Z:= shellfldritems.Count;
sleep(100);
end;
end;
while oShl.AppActivate(''Compressing...'') = True do
begin
Sleep(100);
end;
Nikolay Patarinsky

procedure ShellUnzip(const ZipFile, TargetFldr: string);
var
ShellObj: Variant;
...
ZipFileV, TargetFldrV: Variant;
SrcFldr, DestFldr: Variant;
begin
ShellObj := CreateOleObject(''''Shell.Application'''');
//SrcFldr := shellobj.NameSpace(ZipFile);
// in D2005 SrcFldr will be $000000
// But, this works:
ZipFileV := ZipFile;
SrcFldr := shellobj.NameSpace(ZipFileV);
// do this for all variant parameters
TargetFldrV := TargetFldr;
DestFldr := shellobj.NameSpace(TargetFldrV);
See this course (portuguese): https://www.devmedia.com.br/curso/curso-delphi/1987
RĂ©ulison Silva
All Blog Posts | Next Post | Previous Post
I appreciate you sharing this code,I have been struggling with Abbrevia (open source) and have been unsucessful moving to 2010. This code will allow me to use the operating system, can''t wait to implement. Thanks this is unexpected added value to my subscription to Intraweb.
RMH
Huff R