Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
356 views
in Technique[技术] by (71.8m points)

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

My Inno Setup 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 Inno Setup doesn't provide this feature out of the box, see https://github.com/jrsoftware/issrc/issues/149

While searching for related issues on Stack Overflow, I came up with the question Using callback to display filenames from external decompression dll in 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 Inno Setup 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 '[email protected] stdcall';
function CloseHandle(hObject: THandle): BOOL; external '[email protected] 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;
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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 '[email protected] stdcall';
function CloseHandle(hObject: THandle): BOOL; external '[email protected] 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 '[email protected] stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external '[email protected] stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external '[email protected] 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)


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...