Jen*_*och 5 compression inno-setup 7zip callback
我的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上搜索相关问题时,我想出了一个问题:使用回调来显示来自外部解压缩dll(Inno Setup)的文件名,在那里我找到了Mirals的答案.它使用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;
就像我怀疑使用INFINITE与WaitForSingleObject仍然让主线程.接下来我想用一个较小的超时WaitForSingleObject.但问题仍然是主线程停留在while循环中WaitForSingleObject并且不响应移动.WizardForm.Refresh不会让它变得可动.它只是刷新表单但不处理其他消息(如WM_MOVE).你需要一些Application.ProcessMessages能让窗户移动的东西.由于Inno Setup没有,ProcessMessages我们可以自己创建一个.
下面是您ProcessMessage实现的代码.它等待100毫秒WaitForSingleObject,如果它仍处于等待状态,则执行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;
(此代码经过测试并适用于我)