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

我需要在Delphi中使用Zip和Unzip文件，而不使用第三方组件。如何等待async CopyHere完成ZIP压缩？如何等待异步CopyHere（Shell API命令）完成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;

来源

2013-01-15 dataol

你并不需要自动化壳来做到这一点。正如你发现这并不容易干净。您可以使用Delphi附带的ZIP组件，TZipFile。如果您的Delphi版本较旧，不包含此组件，那么您应该使用第三方组件，如Abbrevia。

来源

2013-01-15 22:04:03

谢谢大卫。单位TZipFile只存在于Delphi XE2中。你可以帮助我在Delphi 2010中完成这项工作吗？ – dataol

嗯，这是XE。无论如何，这个问题没有指定一个版本，所以这个答案很好。例如，2010年你需要使用缩写。 –

我为我的应用程序压缩任务使用[ZipForge]（http://www.componentace.com/zip_component_zip_delphi_zipforge.htm）。 –

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

回答

相关问题