如何在不阻止InnoSetup UI的情况下执行7zip？

Question

我的InnoSetup GUI在解压缩操作过程中被冻结。

我有个procedure DoUnzip(source: String; targetdir: String)与芯

unzipTool := ExpandConstant('{tmp}\7za.exe'); 

Exec(unzipTool, ' x "' + source + '" -o"' + targetdir + '" -y', 
    '', SW_HIDE, ewWaitUntilTerminated, ReturnCode); 

该过程被称为多次和Exec操作块中的用户界面。执行之间只有很短的时间，Inno GUI可拖动/移动。

我知道有TExecWait而不是ewWaitUntilTerminated的其他选项，如ewNoWait和ewWaitUntilIdle，但不幸的是他们在这种情况下没有帮助。使用ewNoWait将导致同时执行多个解压缩操作。

我正在寻找一种方法来执行外部解压缩操作并等待它完成，但不会阻塞用户界面。我怎样才能实现呢？

---

这里是我的笔记和想法：

等待一个过程完成，阻止，除非你从主一个不同的线程等待。我认为需要执行一些回调，当解压缩操作完成时。

我知道，InnoSetup不提供此功能的开箱，见https://github.com/jrsoftware/issrc/issues/149

当搜索StackOverflow上相关的问题，我想出了这个问题Using callback to display filenames from external decompression dll (Inno Setup)，在那里我发现Mirals's answer。它将InnoCallback与另一个DLL结合使用。

我认为，在我的情况下，这可能是7zxa.dll的解压缩操作。但它不接受回调。所以，下面的代码只是一个概念/思想草案。一个问题是，7zxa.dll不接受回调。 另一个问题是7zxa API并没有真正邀请使用。

[Code] 
type 
    TMyCallback = procedure(Filename: PChar); 

// wrapper to tell callback function to InnoCallback 
function WrapMyCallback(Callback: TMyCallback; ParamCount: Integer): LongWord; 
    external 'WrapCallback@files:innocallback.dll stdcall'; 

// the call to the unzip dll 
// P!: the 7zxa.dll doesn't accept a callback 
procedure DoUnzipDll(Blah: Integer; Foo: String; ...; Callback: LongWord); 
    external 'DoUnzipDll@files:7zxa.dll stdcall'; 

// the actual callback action 
procedure MyCallback(Filename: PChar); 
begin 
    // refresh the GUI 
end; 

//----- 

var Callback : LongWord; 

// tell innocallback the callback procedure as 1 parameter 
Callback := WrapMyCallback(@MyCallback, 1); 

// pass the wrapped callback to the unzip DLL 
DoUnzipDll(source, target, ..., Callback); 

procedure DoUnzip(src, target : String); 
begin 
    DoUnzipDll(ExpandConstant(src), ExpandConstant(target)); 
end; 

---

更新

@Rik建议的WinAPI的函数的ShellExecuteEx（）与WaitForSingleObject的INFINITE结合。

我已经实现并测试了这种方法。代码如下。

解压缩的工作，但InnoSetup窗口只能在单个解压缩操作之间短时间移动/拖动。在长时间运行解压缩期间，GUI完全无响应 - 无拖动/不取消按钮。 我已经添加了BringToFrontAndRestore（），但它似乎是新进程的焦点。

const 
    WAIT_OBJECT_0 = $0; 
    WAIT_TIMEOUT = $00000102; 
    SEE_MASK_NOCLOSEPROCESS = $00000040; 
    INFINITE = $FFFFFFFF;  { Infinite timeout } 

type 
    TShellExecuteInfo = record 
    cbSize: DWORD; 
    fMask: Cardinal; 
    Wnd: HWND; 
    lpVerb: string; 
    lpFile: string; 
    lpParameters: string; 
    lpDirectory: string; 
    nShow: Integer; 
    hInstApp: THandle;  
    lpIDList: DWORD; 
    lpClass: string; 
    hkeyClass: THandle; 
    dwHotKey: DWORD; 
    hMonitor: THandle; 
    hProcess: THandle; 
    end; 

function ShellExecuteEx(var lpExecInfo: TShellExecuteInfo): BOOL; 
    external 'ShellExecuteEx{#AW}@shell32.dll stdcall'; 
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; 
    external 'WaitForSingleObject@kernel32.dll stdcall'; 
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall'; 

procedure DoUnzip(source: String; targetdir: String); 
var 
    unzipTool, unzipParams : String;  // path to unzip util 
    ReturnCode : Integer; // errorcode 
    ExecInfo: TShellExecuteInfo; 
begin 
    // source might contain {tmp} or {app} constant, so expand/resolve it to path name 
    source := ExpandConstant(source); 

    unzipTool := ExpandConstant('{tmp}\7za.exe'); 
    unzipParams := ' x "' + source + '" -o"' + targetdir + '" -y'; 

    ExecInfo.cbSize := SizeOf(ExecInfo); 
    ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS; 
    ExecInfo.Wnd := 0; 
    ExecInfo.lpFile := unzipTool; 
    ExecInfo.lpParameters := unzipParams; 
    ExecInfo.nShow := SW_HIDE; 

    if not FileExists(unzipTool) 
    then MsgBox('UnzipTool not found: ' + unzipTool, mbError, MB_OK) 
    else if not FileExists(source) 
    then MsgBox('File was not found while trying to unzip: ' + source, mbError, MB_OK) 
    else begin 

      // ShellExecuteEx combined with INFINITE WaitForSingleObject 

      if ShellExecuteEx(ExecInfo) then 
      begin 
      while WaitForSingleObject(ExecInfo.hProcess, INFINITE) <> WAIT_OBJECT_0 
      do begin 
       InstallPage.Surface.Update;   
       //BringToFrontAndRestore; 
       WizardForm.Refresh(); 
      end; 
      CloseHandle(ExecInfo.hProcess); 
      end; 

    end; 
end; 

Answer 1

像我怀疑使用INFINITE与WaitForSingleObject仍然阻止主线程。接下来我认为使用WaitForSingleObject的更小的超时时间。但问题仍然是主线程停留在WaitForSingleObject的while循环中，并且不响应移动。 WizardForm.Refresh不会使其移动。它只刷新表单，但不处理其他消息（如WM_MOVE）。您需要像Application.ProcessMessages这样的窗口才能移动。由于Inno Setup没有ProcessMessages我们可以自己创建一个。

以下是您的代码，实施了ProcessMessage。它在100毫秒内等待WaitForSingleObject，如果它仍处于等待状态，它将执行ProcessMessage和Refresh。这将允许您移动窗口。您可以使用值为100.

另一种方法可能是您保存了ExecInfo并继续使用其他安装部分。在最后一页中，您可以检查过程是否完成。如果它不与AppProcessMessage循环直到它。

[Code] 
#ifdef UNICODE 
    #define AW "W" 
#else 
    #define AW "A" 
#endif 

const 
    WAIT_OBJECT_0 = $0; 
    WAIT_TIMEOUT = $00000102; 
    SEE_MASK_NOCLOSEPROCESS = $00000040; 
    INFINITE = $FFFFFFFF;  { Infinite timeout } 

type 
    TShellExecuteInfo = record 
    cbSize: DWORD; 
    fMask: Cardinal; 
    Wnd: HWND; 
    lpVerb: string; 
    lpFile: string; 
    lpParameters: string; 
    lpDirectory: string; 
    nShow: Integer; 
    hInstApp: THandle;  
    lpIDList: DWORD; 
    lpClass: string; 
    hkeyClass: THandle; 
    dwHotKey: DWORD; 
    hMonitor: THandle; 
    hProcess: THandle; 
    end; 

function ShellExecuteEx(var lpExecInfo: TShellExecuteInfo): BOOL; 
    external 'ShellExecuteEx{#AW}@shell32.dll stdcall'; 
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; 
    external 'WaitForSingleObject@kernel32.dll stdcall'; 
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall'; 

//----------------------- 
//"Generic" code, some old "Application.ProcessMessages"-ish procedure 
//----------------------- 
type 
    TMsg = record 
    hwnd: HWND; 
    message: UINT; 
    wParam: Longint; 
    lParam: Longint; 
    time: DWORD; 
    pt: TPoint; 
    end; 

const 
    PM_REMOVE  = 1; 

function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall'; 
function TranslateMessage(const lpMsg: TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall'; 
function DispatchMessage(const lpMsg: TMsg): Longint; external 'DispatchMessageA@user32.dll stdcall'; 

procedure AppProcessMessage; 
var 
    Msg: TMsg; 
begin 
    while PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin 
    TranslateMessage(Msg); 
    DispatchMessage(Msg); 
    end; 
end; 
//----------------------- 
//----------------------- 


procedure DoUnzip(source: String; targetdir: String); 
var 
    unzipTool, unzipParams : String;  // path to unzip util 
    ReturnCode : Integer; // errorcode 
    ExecInfo: TShellExecuteInfo; 
begin 
    // source might contain {tmp} or {app} constant, so expand/resolve it to path name 
    source := ExpandConstant(source); 

    unzipTool := ExpandConstant('{tmp}\7za.exe'); 
    unzipParams := ' x "' + source + '" -o"' + targetdir + '" -y'; 

    ExecInfo.cbSize := SizeOf(ExecInfo); 
    ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS; 
    ExecInfo.Wnd := 0; 
    ExecInfo.lpFile := unzipTool; 
    ExecInfo.lpParameters := unzipParams; 
    ExecInfo.nShow := SW_HIDE; 

    if not FileExists(unzipTool) 
    then MsgBox('UnzipTool not found: ' + unzipTool, mbError, MB_OK) 
    else if not FileExists(source) 
    then MsgBox('File was not found while trying to unzip: ' + source, mbError, MB_OK) 
    else begin 

      // ShellExecuteEx combined with INFINITE WaitForSingleObject 

      if ShellExecuteEx(ExecInfo) then 
      begin 
      while WaitForSingleObject(ExecInfo.hProcess, 100) = WAIT_TIMEOUT { WAIT_OBJECT_0 } 
      do begin 
       AppProcessMessage; 
       //InstallPage.Surface.Update;   
       //BringToFrontAndRestore; 
       WizardForm.Refresh(); 
      end; 
      CloseHandle(ExecInfo.hProcess); 
      end; 

    end; 
end; 

（此代码测试，对我的作品）