Blog
All Blog Posts | Next Post | Previous PostZip 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.
2. Monday, December 28, 2009 at 3:13:47 PM
To save the other users time you will need to have the following
uses
Comobj, Windows,Tlhelp32
Then this will complie in 2010... Took a little while to track down, you guys owe me one.....
uses
Comobj, Windows,Tlhelp32
Then this will complie in 2010... Took a little while to track down, you guys owe me one.....
Huff R
3. Sunday, January 3, 2010 at 5:58:42 AM
Are this function for win2000, xp, Vista and Windows 7?
Ruschmeyer Monika
4. Sunday, January 3, 2010 at 6:33:25 AM
This works for Windows XP and newer operating systems
Bruno Fierens
5. Monday, January 4, 2010 at 6:16:46 PM
Great. I''ve been looking for this for YEARS!.. but it doesn''t work in older versions of Delphi (i.e. D6 or 2006) and throws an exception at shellfldritems := srcfldr.Items; but does fine under 2010.
Gabriel Jim
6. Friday, March 11, 2011 at 5:53:50 AM
#5
What to do with this exception in Delphi 2007?
What to do with this exception in Delphi 2007?
Ole
7. Thursday, May 5, 2011 at 1:09:47 PM
Using XP and Delphi 7, I experienced exceptions when trying to use the unzip code. While browsing to find another unzip mechanism, I found this Visual Basic page (http://www.codeguru.com/forum/showthread.php?t=443782) saying their problem only occurred when using variables rather than hard coded strings.
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.
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
8. Thursday, June 30, 2011 at 11:47:28 PM
When unzipping the same file more than 99 times...
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.
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.
9. Tuesday, July 19, 2011 at 3:49:12 AM
For Delphi 2005, the above won''t work.
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);
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
10. Thursday, August 4, 2011 at 12:40:52 PM
Many thanks to the code! And thanks to Russell Ryan for v solution.
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.
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
11. Tuesday, August 30, 2011 at 8:19:43 AM
Hi all,
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.
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
12. Thursday, January 9, 2014 at 6:07:55 AM
Thank you so much Russell
it works
it works
Amir Farid
13. Thursday, May 1, 2014 at 10:42:02 PM
Note that if you pass a filter of anything other than *.* to ShellZip it won''t compress folders unless they end in the same extension.
Fullerton Michael
14. Saturday, December 13, 2014 at 10:10:06 AM
Method with NumProcess don''t work on windows 7 and Delphi 2007...
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;
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
15. Monday, August 27, 2018 at 3:31:50 PM
Yes, you can use this:
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
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