Blog Options

Archive

<< March 2024 >>

Authors


Blog

All Blog Posts  |  Next Post  |  Previous Post

Zip and Unzip files in Delphi without using a 3rd party component

Bookmarks: 

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;
In this function, the progress dialog has been set hidden (with the flag SHCONTCH_NOPROGRESSBOX). The call CopyHere() is blocking for unzipping files. This means that this function will return after all files are effectively unzipped.

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;
Unfortunately, to compress files the flag to hide the shell progress dialog doesn't work. According to Microsoft this is intentional.

Bruno Fierens


Bookmarks: 

This blog post has received 15 comments.


1. Monday, December 28, 2009 at 12:37:45 PM

Bruno

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


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.....



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?

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.


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.

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);


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.

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.

Ashok


12. Thursday, January 9, 2014 at 6:07:55 AM

Thank you so much Russell
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;


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

Réulison Silva




Add a new comment

You will receive a confirmation mail with a link to validate your comment, please use a valid email address.
All fields are required.



All Blog Posts  |  Next Post  |  Previous Post