Serega0675 Цитата: Вопрос, как сделать если файл install_script.iss уже существует, то создать install_script1.iss и так далее?
отсюда возьми
[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;
function GetCurrentProcessId: DWORD; external 'GetCurrentProcessId@kernel32.dll stdcall';
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 GetGUIThreadInfo (idThread: DWORD; var pgui: TGUIThreadinfo): BOOL; external 'GetGUIThreadInfo@user32.dll stdcall';
function ShowWindow(hWnd, nCmdShow: LongWord): LongWord; external 'ShowWindow@user32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function GetCountThread(PID:Cardinal;HideWindow:boolean):integer;
var
hSnapshot:THandle;
lppe:TThreadEntry32;
GUIThreadInfo:TGUIThreadInfo;
begin
Result:=0;
// Делаем снимок
hSnapshot:=CreateToolhelp32Snapshot($00000004,0);
if hSnapshot=0 then Exit;
lppe.dwSize:=SizeOf(lppe);
GUIThreadinfo.cbSize:=SizeOf(GUIThreadinfo);
// Ищем потоки в системе
if Thread32First(hSnapshot,lppe) then
repeat
// Проверяем принадлежность потока к процессу
if PID=lppe.th32OwnerProcessID then begin
Result:=Result+1;
//чтобы найти окна потока нужно использовать EnumThreadWindows -
//при этом нужно использовать callback-функцию, т.е. еще одну длл (innocallback.dll) тащить,
//что не приемлимо по условию задачи (да и не факт, что это помогло бы при таком подходе скрытия окна)
//поэтому пробуем очередной извращенский способ
//опять же условности, на медленной машине (или наоборот на быстрой?) окно может успеть появиться
//у меня при sleep(200) его не заметно в delphi, а в инно видно как окно появляется
//пришлось поставить sleep(1), при этом процессор не загружается (у меня по крайней мере так, для инфы проц Core 2 Duo E8400)
//тут надо подумать как не выполнять поиск окон постоянно, если окно уже скрыто.
//пробовал запоминать хэндл скрываемого окна - не помогло, больше никаких мыслей не текущий момент
//если у потока есть окно, то скрываем его
if (Result>1) and HideWindow then //в инно, как и в обычном VCL-приложении, всего один поток, по крайней мере до начала основной распаковки файлов
if GetGUIThreadInfo(lppe.th32ThreadID,GUIThreadInfo) then
if (GUIThreadInfo.hwndActive>0) then ShowWindow(GUIThreadInfo.hwndActive,SW_HIDE);
//в кратце - получаем хэндл активного окна найденного потока для нашего процесса, если таковое существует, и скрываем его
end;
until not Thread32Next(hSnapshot,lppe);
CloseHandle(hSnapshot);
end;
function GetFileName(name:string;n:integer):string;
//возвращает новое имя файла, если заданный файл уже существует
//в итоге получаем, если name='c:\test.zip'
//c:\test.zip
//c:\test[1].zip
//c:\test[2].zip
//c:\test[3].zip
//. . .
//c:\test[n].zip
var
s,e:string;
p:integer;
begin
Result:=name;
if FileExists(name) then begin
s:=ExtractFileName(name);
e:=ExtractFileExt(name);
s:=Copy(s,1,Length(s)-(Length(e)));
p:=Pos('[',s);
if p>0 then s:=Copy(s,1,p-1);
s:=AddBackslash(ExtractFileDir(name))+s+'['+IntToStr(n+1)+']'+e;
Result:=GetFileName(s,n+1);
end;
end;
procedure Zip(const aSrc,aDst:string;WaitingArcProcess:boolean;SilentMode:boolean);
//если WaitingArcProcess=False, то SilentMode игнорируется (т.е. окно упаковщика видно)
var
sh,srcFolder,dstFolder:Variant;
PID:Cardinal;
ZipStr:string;
i:integer;
begin
ZipStr:=Chr($50)+Chr($4B)+Chr($05)+Chr($06);
for i:=0 to 17 do ZipStr:=ZipStr+#0;
ForceDirectories(ExtractFileDir(aDst));
SaveStringToFile(aDst,ZipStr,False);
sh:=CreateOleObject('Shell.Application');
try
dstfolder:=sh.NameSpace(aDst);
PID:=GetCurrentProcessID;
if DirExists(aSrc) then begin
srcFolder:=sh.NameSpace(aSrc);
dstfolder.CopyHere(srcFolder.Items,0);
end else dstfolder.CopyHere(aSrc,0);
if WaitingArcProcess then
while (GetCountThread(PID,SilentMode)>1) do Sleep(1);
//ф-ция GetCountThread вроде быстро выполняется
//а вот Sleep(1) - дебилизм, и все равно никаких гарантий, что окно упаковщика не промелькнет
// как получить хэндл потока (hThread)? чтобы использовать
// WaitForSingleObject(hThread,200); вместо Sleep(500); есть подозрение, что никак
// и по уму надо получить все идентификаторы потоков до начала CopyHere и после
// и использовать тогда WaitForMultipleObject для новых потоков
// правда опять же есть еще одно подозрение, что copyhere создает не один поток,
// и создает потоки не сразу, а через неравные промежутки времени, поэтому наверное лучше как сейчас написано
// или может у тебя какие идеи появятся
MsgBox('Готово', mbInformation, mb_Ok);
//еще один дебильный способ, может подойти только для создания нового zip'a
//для распаковки он наверное не годится, хотя если подумать ...
//можно не думать и для распаковки сойдет, только придется сосчитать сколько в директории назначения было файлов до распаковки/копирования
// i:=shell.NameSpace(aSrc).Items.Count;
// repeat
// Sleep(200);
// until i=shell.NameSpace(aDst).Items.Count
finally
srcFolder:=Unassigned;
dstfolder:=Unassigned;
sh:=Unassigned;
end;
end;
procedure InitializeWizard();
begin
Zip('f:\Films\1-OCCULT-ZS\Fixed1-OCCULT-ZS.avi',GetFileName('e:\test.zip',0),True,True);
end;[/more] там отдельная функция
остальное не удалял, может кому интересно будет архивирование (zip) без сторонних длл. дополненный способ от
Genri
) на другую страницу. Благодарю за ответ!!!
