CODEWITHSUNDEEP
delphiwinapiasynchronousprocesszip
dataol
dataol

Reputation: 1009

How to wait until the async CopyHere (Shell API command) completing the ZIP compression?

I need to Zip and Unzip files in Delphi without using a 3rd party component. How to wait until the async CopyHere completing the ZIP compression?

The following code is not working perfectly.

Code to zipping files using ShellAPI

procedure TShellZip.ZipFolder(const SourceFolder: WideString);
var
  SrcFldr, DestFldr: OleVariant;
  ShellFldrItems: Olevariant;
  NumT: Integer;
begin
  if not FileExists(ZipFile) then
  begin
    CreateEmptyZip;
  end;

  NumT := NumProcessThreads;
  ShellObj := CreateOleObject('Shell.Application');
  SrcFldr := GetNameSpaceObj(SourceFolder);

  if not IsValidDispatch(SrcFldr) then
  begin
    raise EInvalidOperation.CreateFmt('<%s> Local de origem inválido.', [SourceFolder]);
  end;

  DestFldr := GetNameSpaceObj_ZipFile;
  ShellFldrItems := SrcFldr.Items;

  if (Filter <> '') then
  begin
    ShellFldrItems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS, Filter);
  end;

  DestFldr.CopyHere(ShellFldrItems, SHCONTCH_NOPROGRESSBOX or SHCONTCH_RESPONDYESTOALL);

  //wailt async processes
  while NumProcessThreads <> NumT do
  begin
    Sleep(100);
  end;
end;

Code to count processes

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;

Code to create empty zip stream

procedure TShellZip.CreateEmptyZip;
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;
begin
  //criar um arquivo zip vazio
  Ms := TMemoryStream.Create;
  try
    Ms.WriteBuffer(EmptyZip, SizeOf(EmptyZip));
    Ms.SaveToFile(ZipFile);
  finally
    Ms.Free;
  end;
end;

Upvotes: 2

Views: 1830

Answers (1)

David Heffernan
David Heffernan

Reputation: 612993

You don't need to automate the shell to do this. As you have discovered that's not easy to do cleanly.

You can use the ZIP component that ships with Delphi, TZipFile. If you have an older version of Delphi, one that does not include this component, then you should use a third party component like Abbrevia.

Upvotes: 5

Related Questions