我需要在不使用第三方组件的情况下在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;