サードパーティのコンポーネントを使用せずに、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;