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

时间：2015-08-27 18:00:42

标签： callback inno-setup 7zip compression

我的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（）与INFINITE WaitForSingleObject结合使用。

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

解压缩有效，但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;

1 个答案:

答案 0 :(得分：6)

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

以下是您实施ProcessMessage的代码。对WaitForSingleObject进行100毫秒的等待，如果它仍处于等待状态，则执行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;

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

相关问题
最新问题