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

后端 未结 1 406
醉话见心
醉话见心 2020-12-10 17:42

My Inno Setup GUI is frozen during unzip operations.

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



        
相关标签:
1条回答
  • 2020-12-10 18:17

    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)

    0 讨论(0)
提交回复
热议问题