My Inno Setup GUI is frozen during unzip operations.
I\'ve a procedure DoUnzip(source: String; targetdir: String)
with the core
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)