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

Question

我的 Inno Setup GUI 在解压缩操作期间被冻结。

我有一个procedure DoUnzip(source: String; targetdir: String)有核心

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

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

此过程被多次调用，Exec 操作阻塞了用户界面。执行之间只有很短的时间，Inno GUI 是 dragable/moveable.

我知道还有其他选项 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, where I found 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() 与 INFINITE WaitForSingleObject.

结合使用

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

解压缩有效，但 Inno Setup window 仅 moveable/dragable 在各个解压缩操作之间的一小段时间。在长时间运行解压缩期间，GUI 完全没有响应 - 没有 dragging/no 取消按钮。我已经添加了 BringToFrontAndRestore()，但似乎新流程有重点。

const
  WAIT_OBJECT_0 = [=13=];
  WAIT_TIMEOUT = [=13=]000102;
  SEE_MASK_NOCLOSEPROCESS = [=13=]000040;
  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}za.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 这样的东西来允许 windows 移动。由于 Inno Setup 没有 ProcessMessages 我们可以自己创建一个。

下面是您实现了 ProcessMessage 的代码。它等待 WaitForSingleObject 100 毫秒，如果它仍处于等待状态，它会执行 ProcessMessage 和 Refresh。这将允许您移动 window。值100可以玩一点。

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

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

const
  WAIT_OBJECT_0 = [=10=];
  WAIT_TIMEOUT = [=10=]000102;
  SEE_MASK_NOCLOSEPROCESS = [=10=]000040;
  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}za.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;

（此代码已经过测试并且适用于我）

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

How to execute 7zip without blocking the Inno Setup UI?

callback

compression

inno-setup

7zip

pascalscript