如何等到异步 CopyHere（Shell API 命令）完成 ZIP 压缩？答案

【问题标题】：How to wait until the async CopyHere (Shell API command) completing the ZIP compression?如何等到异步 CopyHere（Shell API 命令）完成 ZIP 压缩？
【发布时间】：2013-01-15 22:01:19
【问题描述】：

我需要在 Delphi 中压缩和解压缩文件而不使用 3rd 方组件。如何等到异步 CopyHere 完成 ZIP 压缩？

以下代码无法正常运行。

使用 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;

计算进程的代码

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;

创建空压缩流的代码

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;

【问题讨论】：

标签： delphi winapi asynchronous process zipfile

【解决方案1】：

您不需要自动化外壳来执行此操作。正如您所发现的那样，干净地做到这一点并不容易。

您可以使用 Delphi 附带的 ZIP 组件TZipFile。如果您有旧版本的 Delphi，但不包含此组件，则应使用第三方组件，例如 Abbrevia。

【讨论】：

谢谢大卫。 TZipFile 单元仅存在于 Delphi XE2 中。你能帮我在 Delphi 2010 中完成这项工作吗？
嗯，它是 XE。无论如何，这个问题没有指定版本，所以这个答案很好。例如，对于 2010 年的您，您需要使用缩写词。
我将ZipForge 用于我的应用程序压缩任务。