Question

我需要在不使用第三方组件的情况下在Delphi中压缩和解压缩文件。如何等待async 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;

Answer 1

您无需自动执行shell即可。正如你所发现的那样干净利落并不容易。

您可以使用Delphi附带的ZIP组件TZipFile。如果你有一个旧版本的Delphi，一个不包含这个组件的版本，那么你应该使用像Abbrevia这样的第三方组件。

如何等待async CopyHere（Shell API命令）完成ZIP压缩？

1 个答案: