callback - 如何在不阻塞 Inno Setup UI 的情况下执行 7zip？

Question

我的 Inno Setup 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将导致同时执行多个解压缩操作。
我正在寻找一种方法来执行外部解压缩操作并等待它完成，但不会阻塞用户界面。我该如何实现？

以下是我的笔记和想法:
等待进程完成是阻塞的，除非您将在与主线程不同的线程中等待。我认为需要在解压缩操作完成时执行某种回调。
我知道 Inno Setup 不提供开箱即用的此功能，请参阅 https://github.com/jrsoftware/issrc/issues/149
在 Stack Overflow 上搜索相关问题时，我想到了问题 Using callback to display filenames from external decompression dll in 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 .
我已经实现并测试了这种方法。代码如下。
解压缩工作，但 Inno Setup 窗口只能在各个解压缩操作之间短暂移动/拖动。在长时间运行解压缩期间，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 这样的东西允许 window 移动。由于 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;

(此代码经过测试并适用于我)