How to execute 7zip without blocking the InnoSetup UI?

问题

My InnoSetup GUI is frozen during unzip operations.

I've a procedure DoUnzip(source: String; targetdir: String) with the core

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

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

This procedure is called multiple times and the Exec operation blocks the user interface. There is only a very short moment between the executions, where the Inno GUI is dragable/moveable.

I know that there are other options for TExecWait instead of ewWaitUntilTerminated, like ewNoWait and ewWaitUntilIdle, but unfortunately they are not helpful in this case. Using ewNoWait would result in the execution of multiple unzip operations at the same time.

I'm looking for a way to execute an external unzip operation and wait for it to finish, but without blocking the user interface. How can i implement that?

Here are my notes and ideas:

Waiting for a process to finish, is blocking, unless you'll be waiting in a thread different from the main one. I think some kind of callback is needed, which is executed, when the unzip operation finishes.

I'm aware that InnoSetup doesn't provide this feature out of the box, see https://github.com/jrsoftware/issrc/issues/149

While searching for related issues on StackOverflow, i came up with the question Using callback to display filenames from external decompression dll (Inno Setup), where i found Mirals's answer. It's using InnoCallback combined with another DLL.

I think, in my case this could be 7zxa.dll for the unzip operation. But it doesn't accept a callback. So, the following code is just a concept / idea draft. One problem is, that 7zxa.dll doesn't accept a callback. Another problem is that the 7zxa API is not really inviting to work with.

[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;

Update

@Rik suggested to combine the WinAPI function ShellExecuteEx() with INFINITE WaitForSingleObject.

I've implemented and tested this approach. The code is below.

The unzipping works, but the InnoSetup window is only moveable/dragable for a short moment between the individual unzip operations. During a long running unzip the GUI is fully unresponsive - no dragging/no cancel button. I've added BringToFrontAndRestore(), but it seems the new process has the focus.

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:

Like I suspected using INFINITE with WaitForSingleObject still blocks the main-thread. Next I thought using a smaller timeout with WaitForSingleObject. But the problem is still that the main-thread stays in the while loop of WaitForSingleObject and doesn't respond to moving. WizardForm.Refresh does not make it movable. It just refreshes the form but doesn't process other messages (like WM_MOVE). You need something like Application.ProcessMessages to allow the windows to move. Since Inno Setup doesn't have a ProcessMessages we could create one ourselves.

Below is your code with a ProcessMessage implemented. It does a 100 millisecond wait for WaitForSingleObject and if it's still in the wait-state it executes the ProcessMessage and Refresh. This will allow you to move the window. You can play a little with the value 100.

Another way could be that you save the ExecInfo and go on with some other install-part. In the final page you could check if the process is finished. If it's not loop with the AppProcessMessage until it is.

[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;

(This code is tested and works for me)

来源：https://stackoverflow.com/questions/32256432/how-to-execute-7zip-without-blocking-the-innosetup-ui

标签

callback

inno-setup

7zip

compression