cdman67 Цитата: Добрый день, господа !!! Подскажите, возможен ли вывод окна SFX-архива, запускаемого в процессе инсталляции, в произвольном месте экрана или эта задача принципиально нерешабельна средствами инно ? Если этот вопрос уже освещался - просьба подтвердить, я не поленюсь перелопатить все 4 ветки )
хм, уболтал. выложу здесь, может кому еще пригодится
вот [more=примерчик][Setup]
AppName=My Program
AppVerName=My Program v.1.2
DirExistsWarning=no
DefaultDirName={pf}\My Program
[Code_]
type
TThreadEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ThreadID: DWORD;
th32OwnerProcessID: DWORD;
tpBasePri: Longint;
tpDeltaPri: Longint;
dwFlags: DWORD;
end;
TGUIThreadinfo = record
cbSize: DWORD;
flags: DWORD;
hwndActive: HWND;
hwndFocus: HWND;
hwndCapture: HWND;
hwndMenuOwner: HWND;
hwndMoveSize: HWND;
hwndCaret: HWND;
rcCaret: TRect;
end;
TMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;
TProcessEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD;
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD;
cntThreads: DWORD;
th32ParentProcessID: DWORD;
pcPriClassBase: Longint;
dwFlags: DWORD;
szExeFile: array[0..259] of Char;
end;
var
AppHandle:HWND;
function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
function Thread32First(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32First@kernel32.dll stdcall';
function Thread32Next(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32Next@kernel32.dll stdcall';
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32First@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32Next@kernel32.dll stdcall';
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; external 'OpenProcess@kernel32.dll stdcall';
function GetGUIThreadInfo (idThread: DWORD; var pgui: TGUIThreadinfo): BOOL; external 'GetGUIThreadInfo@user32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, wFlags: Longint):boolean; external 'SetWindowPos@user32.dll stdcall';
function WaitForInputIdle(hProcess: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForInputIdle@user32.dll stdcall';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForSingleObject@kernel32.dll stdcall';
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';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll';
function GetAppHandle:HWND;
begin
Result:=GetWindowLong(MainForm.Handle,-8);
end;
procedure AppProcessMessage;
var
Msg: TMsg;
begin
while PeekMessage(Msg,AppHandle,0,0,1) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
procedure GetProcessParam(const FileName:string; var PHandle:THandle; var PID:Cardinal);
var
h:THandle;
PS:TProcessEntry32;
fn:string;
i:integer;
begin
h:=CreateToolHelp32Snapshot($00000002,0);
if h=0 then Exit;
PS.dwSize:=SizeOf(PS);
if Process32First(h,PS) then
repeat
fn:=''; //идиотизм, но по-другому не получилось
for i:=0 to 254 do begin
if PS.szExeFile[i]=#0 then Break;
fn:=fn+PS.szExeFile[i];
end;
if AnsiUpperCase(fn)=AnsiUpperCase(FileName) then begin
PID:=PS.th32ProcessID;
Break;
end;
until not Process32Next(h,PS);
CloseHandle(h);
PHandle:=OpenProcess($001F0FFF,False,PID);
end;
procedure GetWndHandle(PID:Cardinal; var hWnd:HWND);
var
h:THandle;
TS:TThreadEntry32;
GUIThreadInfo:TGUIThreadInfo;
begin
h:=CreateToolhelp32Snapshot($00000004,0);
if h=0 then Exit;
TS.dwSize:=SizeOf(TS);
GUIThreadinfo.cbSize:=SizeOf(GUIThreadinfo);
if Thread32First(h,TS) then
repeat
if PID=TS.th32OwnerProcessID then
if GetGUIThreadInfo(TS.th32ThreadID,GUIThreadInfo) then
if (GUIThreadInfo.hwndActive>0) then begin
hWnd:=GUIThreadInfo.hwndActive;
Break;
end;
until not Thread32Next(h,TS);
CloseHandle(h);
end;
procedure ExecAppAndMoveWindow(Filename,Params,WorkingDir:string;X,Y:integer;WaitingProcess:boolean);
var
ErrorCode: Integer;
PID:Cardinal;
PH:THandle;
PWndHandle:HWND;
begin
//при таком подходе SW_HIDE ставить нельзя, окно не найдется, что хреново, будет видно перемещение окна
if not ShellExec('',Filename,Params,WorkingDir,SW_SHOW,ewNoWait,ErrorCode) then Exit;
PH:=0;
PID:=0;
PWndHandle:=0;
GetProcessParam(FileName,PH,PID);
try
if (PID<>0) and (PH<>0) then begin
WaitForInputIdle(PH,DWORD($FFFFFFFF));
//здесь надо бы юзать EnumThreadWindows (тогда бы можно было использовать SW_HIDE в ShellExec и все бы было красиво),
//но это тащить с собой innocallback.dll, поэтому попробуем по-другому
GetWndHandle(PID,PWndHandle);
if PWndHandle<>0 then begin
SetWindowPos(PWndHandle,0,X,Y,0,0,$41);
if WaitingProcess then begin
AppHandle:=GetAppHandle;
while WaitForSingleObject(PH,200)<>0 do AppProcessMessage;
end;
end;
end;
finally
CloseHandle(PH);
end;
end;
procedure InitializeWizard();
begin
//огрангичения - если запущено несколько одноименных процессов, то работать будет криво, лучше наверное сказать - не будет
//из неприятного - видно перемещение окна. от этого можно избавиться если использовать innocallback.dll
ExecAppAndMoveWindow('notepad.exe','e:\test.txt','',250,250,True);
end;[/more]
здесь есть свои ограничения и неприятности
по правильному нужно писать dll и делать совсем по-другому
Добавлено: EagleSH зачем тебе для рисования фона на форме isxbb? это можно и без нее сделать