2

我需要在不使用 3rd 方组件的情况下在 Delphi 中压缩和解压缩文件。如何等到异步 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;

创建空 zip 流的代码

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

1 回答 1

5

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

您可以使用 Delphi 附带的 ZIP 组件TZipFile。如果您有较旧版本的 Delphi，其中不包含此组件，那么您应该使用第三方组件，例如Abbrevia。

于 2013-01-15T22:04:03.797 回答