Скрипты Inno Setup. Помощь и советы [часть 7]

[Dodakaedr]

Kashtan007, добавьте такое
[Code]
var
Init: Boolean;

procedure InitializeWizard();
begin
Init := True;
end;

procedure DeinitializeSetup();
begin
if Init <> False then
begin
RemoveFontResource(ExpandConstant('{tmp}\{#Font}'), FR_PRIVATE, 0);
UnloadSkin;
WizardForm.Free;
end;
end;

[saurn]

Dodakaedr, Kashtan007, зачем плодить дубли InitializeSetup? Грамотней оформить действия отдельными блоками функций и последовательно проверять результат. Это, как минимум, упрощает читаемость и оптимизирует организацию структуры кода.
function MyFunc1(): Boolean;
begin
Result := ...;
end;

function MyFunc2(): Boolean;
begin
Result := ...;
end;

function InitializeSetup(): Boolean;
begin
Result := MyFunc1();
if Result then Result := MyFunc2();
end;

WizardForm.Free; »
Форма и так разрушится при выходе.

[Irenis]

[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[INI]
Filename: {userdesktop}\Перейти на сайт.url; Section: InternetShortcut; Key: URL; String: http://forum.oszone.net;
[UninstallDelete]
Name: {userdesktop}\Перейти на сайт.url; Type: files; »

Спасибо, попробовала, все получилось. Единственное, подскажите пожалуйста, как задать свою картинку для ярлыка?

[kotyarko@fb]

Форма и так разрушится при выходе. »
При некотором количестве хэндлов этой формы, при выходе программа может неправильно завершаться. Ошибок, как таковых, не будет, но окно "Программа неожиданно завершилась.." или что-то подобное (точно не помню), будет поднапрягать.

[Kashtan007]

saurn, есть ли альтернативные способы, чтобы форма не рушилась?

P.S. Когда нажимаешь "Нет" либо "Да", все работает идеально. Но если закрываешь сам установщик, то сразу рушится скин.

[saurn]

При некотором количестве хэндлов этой формы, при выходе программа может неправильно завершаться »
Что мешает закрыть хэндлы?
Но если закрываешь сам установщик, то сразу рушится скин. »
А это потому, что разрушаете форму раньше, чем выгружаете скин. При закрытии форма уничтожается. Ну или разрушайте ее после выполнения всех действий.
procedure DeinitializeSetup();
begin
RemoveFontResource(ExpandConstant('{tmp}\{#Font}'), FR_PRIVATE, 0);
UnloadSkin;

WizardForm.Free;
end;

-----------------------------------------------------------------------------------------
Единственное, подскажите пожалуйста, как задать свою картинку для ярлыка? »
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp


[INI]
Filename: {app}\Перейти на сайт.url; Section: InternetShortcut; Key: URL; String: http://forum.oszone.net;

[Icons]
Name: {userdesktop}\Сайт программы; Filename: {app}\Перейти на сайт.url; WorkingDir: {app}; IconFilename: {uninstallexe}; IconIndex: 0;


[UninstallDelete]
Name: {app}\Перейти на сайт.url; Type: files;

[icetanker]

парни,подскажите,как без прогрессбара сделать,так,чтобы файл ActiveX качался с сайта в определенную директорию и после этого регистрировался?про прогрессбар в шапке прочитал,не совсем понял.

[kotyarko@fb]

Что мешает закрыть хэндлы? »
Есть множество примеров, использующих хэндл визарда (или его "детей"). И не только лишь все не изменяют этот пример, при добавлении к себе в код. От этого появляются несколько хэндлов, которые нужно как-то освобождать. Решение тому - WizardForm.Free, при деинициализации.

[saurn]

И не только лишь все не изменяют этот пример, при добавлении к себе в код. »
Бесспорно. Однако WizardForm.Free - не решение. Скорее аварийный выход. Правильное решение - "разрушать" то, что создаешь.

[kotyarko@fb]

Однако WizardForm.Free - не решение. Скорее аварийный выход. Правильное решение - "разрушать" то, что создаешь »
Не стоит забывать об прогромистах (http://lurkmore.to/%D0%91%D1%8B%D0%B4%D0%BB%D0%BE%D0%BA%D0%BE%D0%B4%D0%B5%D1%80), которые не в силах изменить найденный и нужный им пример.

[Kashtan007]

saurn, есть ли варианты без использования IsTasks.dll?

[svs23]

помогите увязать
procedure CurStepChanged(CurStep: TSetupStep);
begin
case CurStep of
ssInstall:
begin
BackupCheck_2();
BackupCheck_3();
end;
ssDone:
begin
RewritingUninstallData();
end;
end;
end;
и
begin
If CurStep=ssInstall then
begin
CreateDir(ExpandConstant('{app}\res_mods'));
CreateLogMods();
end;
end;
заранее спс

[Habetdin]

svs23, procedure CurStepChanged(CurStep: TSetupStep);
begin
case CurStep of
ssInstall:
begin
BackupCheck_2();
BackupCheck_3();
CreateDir(ExpandConstant('{app}\res_mods'));
CreateLogMods();
end;
ssDone:
begin
RewritingUninstallData();
end;
end;
end;

[saurn]

есть ли варианты без использования IsTasks.dll? »
Объеденить примеры из шапки:
Запущен ли процесс (http://forum.oszone.net/post-1800689-218.html), Закрытие процесса (http://forum.oszone.net/post-2401734-1524.html)
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp


[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
TH32CS_SNAPPROCESS = $2;
INVALID_HANDLE_VALUE = -1;
PROCESS_TERMINATE = $1;
PROCESS_CREATE_THREAD = $2;
PROCESS_QUERY_INFORMATION = $400;
SYNCHRONIZE = $100000;
TOKEN_QUERY = $8;
TOKEN_ADJUST_PRIVILEGES = $20;
SE_PRIVILEGE_ENABLED = $2;
TA_FAILED = 0;
TA_SUCCESS_CLEAN = 1;
TA_SUCCESS_KILL = 2;
WM_CLOSE = $10;
WAIT_OBJECT_0 = $0;
WAIT_TIMEOUT = $102;
WAIT_FAILED = $FFFFFFFF;
SMTO_BLOCK = $1;
SMTO_ABORTIFHUNG = $2;

type
TPROCESSENTRY32 = record
dwSize, cntUsage, th32ProcessID: DWORD;
th32DefaultHeapID: Longint;
th32ModuleID, cntThreads, th32ParentProcessID: DWORD;
pcPriClassBase: Longint;
dwFlags: DWORD;
szExeFile: array [0..259] of Char;
end;

LUID = record
LowPart: DWORD;
HighPart: Longint;
end;

LUID_AND_ATTRIBUTES = record
Luid: LUID;
Attributes: DWORD;
end;

TOKEN_PRIVILEGES = record
PrivilegeCount: DWORD;
Privileges: array [0..0] of LUID_AND_ATTRIBUTES;
end;

function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
#ifdef UNICODE
function Process32First(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32First{#A}@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32Next{#A}@kernel32.dll stdcall';
#else
function Process32First(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32First@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32Next@kernel32.dll stdcall';
#endif
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; external 'OpenProcess@kernel32.dll stdcall';
function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD; var TokenHandle: THandle): BOOL; external 'OpenProcessToken@advapi32.dll stdcall';
function GetCurrentProcess(): THandle; external 'GetCurrentProcess@kernel32.dll stdcall';
function LookupPrivilegeValue(lpSystemName, lpName: String; var lpLuid: LUID): BOOL; external 'LookupPrivilegeValue{#A}@advapi32.dll stdcall';
function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; NewState: TOKEN_PRIVILEGES; BufferLength: DWORD; var PreviousState: TOKEN_PRIVILEGES; var ReturnLength: Longint): BOOL; external 'AdjustTokenPrivileges@advapi32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function GetProcessImageFileName(hProcess: THandle; var lpImageFileName: Char; nSize: DWORD): DWORD; external 'GetProcessImageFileName{#A}@psapi.dll stdcall';
function GetLogicalDrives(): DWORD; external 'GetLogicalDrives@kernel32.dll stdcall';
function QueryDosDevice(lpDeviceName: String; var lpTargetPath: Char; ucchMax: DWORD): DWORD; external 'QueryDosDevice{#A}@kernel32.dll stdcall';
function EnumWindows(lpEnumFunc, lParam: Longint): BOOL; external 'EnumWindows@user32.dll stdcall';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForSingleObject@kernel32.dll stdcall';
function GetProcAddress(hModule: THandle; lpProcName: AnsiString): Longint; external 'GetProcAddress@kernel32.dll stdcall';
function GetModuleHandle(lpModuleName: String): THandle; external 'GetModuleHandle{#A}@kernel32.dll stdcall';
function CreateRemoteThread(hProcess: THandle; lpThreadAttributes, dwStackSize, lpStartAddress, lpParameter, dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; external 'CreateRemoteThread@kernel32.dll stdcall';
function TerminateProcess(hProcess: THandle; uExitCode: UINT): BOOL; external 'TerminateProcess@kernel32.dll stdcall';
function GetWindowThreadProcessId(hWnd: HWND; var lpdwProcessId: DWORD): DWORD; external 'GetWindowThreadProcessId@user32.dll stdcall';
function SendMessageTimeout(hWnd: HWND; Msg: UINT; wParam, lParam: Longint; fuFlags, uTimeout: UINT; var lpdwResult: Longint): Longint; external 'SendMessageTimeout{#A}@user32.dll stdcall';

////////////////////////////////////////////////////////////
function IsProcessRunning(FileName: String): Boolean; //FileName - имя exe-файла процесса
var
hProcessSnap: THandle;
pe32: TPROCESSENTRY32;
szExeFile: String;
begin
hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hProcessSnap = INVALID_HANDLE_VALUE then Exit;
pe32.dwSize := sizeof(pe32);
if not Process32First(hProcessSnap, pe32) then Exit;
while not Result and Process32Next(hProcessSnap, pe32) do
begin
szExeFile := '';
while not (pe32.szExeFile[Length(szExeFile)] = #0) do szExeFile := szExeFile + pe32.szExeFile[Length(szExeFile)];
Result := LowerCase(FileName) = LowerCase(szExeFile);
end;
CloseHandle(hProcessSnap);
end;

/////////////////////////////////////////////////////////
function CharArrayToString(aChar: array of Char): String;
begin
Result := '';
while aChar[Length(Result)] <> #0 do Insert(aChar[Length(Result)], Result, Length(Result)+1);
end;

////////////////////////////////////////////////////////////
function EnumWindowsProc(hwnd: HWND; lParam: Longint): BOOL;
var
dwID: DWORD;
lResult: Longint;
begin
Result := True;
GetWindowThreadProcessId(hwnd, dwID);
if dwID = lParam then
Result := SendMessageTimeout(hwnd, WM_CLOSE, 0, 0, SMTO_BLOCK or SMTO_ABORTIFHUNG, 5000, lResult) <> 0;
end;

//////////////////////////////////////////////////////////////////////////////////
function TerminateApp(const szProcessList: String; const dwTimeout: DWORD): DWORD;
// szProcessList : process names or full paths of processes delimited by vertical bar, e.g. calc.exe|notepad.exe|c:\hungtest.exe
// dwTimeout.....: kill timeout in ms
var
hProcessSnap, hProc, hToken, hThread, lpProcName: THandle;
pe32: TPROCESSENTRY32;
aBuf: array [0..259] of Char;
bProcFind: Boolean;
szExeFile, szExePath, szFileName, szDeviceName: String;
tkp: TOKEN_PRIVILEGES;
SeDebugNameValue: LUID;
i, ret: Longint;
lpThreadId, dwDrives: DWORD;
begin
hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hProcessSnap = INVALID_HANDLE_VALUE then Exit;
try
with TStringList.Create do
try
StringChangeEx(szProcessList, '|', #13#10, True);
Text := szProcessList;
//
pe32.dwSize := SizeOf(pe32);
if not Process32First(hProcessSnap, pe32) then Exit;
repeat
bProcFind := False;
szExeFile := CharArrayToString(pe32.szExeFile);
for i := 0 to Count-1 do
begin
if CompareText(szExeFile, ExtractFileName(Strings[i])) = 0 then
begin
bProcFind := True;
szExePath := Strings[i];
Break;
end;
end;
if not bProcFind then Continue;

// try open process
hProc := OpenProcess(PROCESS_TERMINATE or PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or SYNCHRONIZE, False, pe32.th32ProcessID);
if hProc = TA_FAILED then
begin
// open process token adjust privileges
if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then Exit;
if not LookupPrivilegeValue('', 'SeDebugPrivilege', SeDebugNameValue) then Exit;
try
// fill token privileges struct
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Luid := SeDebugNameValue;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

// set debug privileges
if not AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), tkp, ret) then Exit;

// try open process with debug privileges
hProc := OpenProcess(PROCESS_TERMINATE or PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or SYNCHRONIZE, False, pe32.th32ProcessID);
if hProc = TA_FAILED then Exit;
finally
tkp.Privileges[0].Attributes := 0;
AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), tkp, ret);
CloseHandle(hToken);
end;
end;

// if szProcess is full path
if CompareText(szExePath, szExeFile) <> 0 then
begin
GetProcessImageFileName(hProc, aBuf[0], SizeOf(aBuf));
szFileName := CharArrayToString(aBuf);
dwDrives := GetLogicalDrives();
for i := 2 to 25 do if dwDrives and (1 shl i) <> 0 then
begin
QueryDosDevice(Format('%s:', [Chr(Ord('A') + i)]), aBuf[0], SizeOf(aBuf));
szDeviceName := CharArrayToString(aBuf);
if Pos(szDeviceName, szFileName) = 0 then Continue;
StringChangeEx(szFileName, szDeviceName, Format('%s:', [Chr(Ord('A') + i)]), True);
if CompareText(szExePath, szFileName) = 0 then Break;
end;
if CompareText(szExePath, szFileName) <> 0 then
begin
CloseHandle(hProc);
Continue;
end;
end;

// try stop process
try
if not EnumWindows(CallbackAddr('EnumWindowsProc'), pe32.th32ProcessID) then
begin
if TerminateProcess(hProc, 0) then Result := TA_SUCCESS_KILL;
end else case WaitForSingleObject(hProc, dwTimeout) of
WAIT_OBJECT_0: Result := TA_SUCCESS_CLEAN;
WAIT_TIMEOUT: try
lpProcName := GetProcAddress(GetModuleHandle('kernel32.dll'), 'ExitProcess');
if lpProcName = 0 then Exit;
hThread := CreateRemoteThread(hProc, 0, 0, lpProcName, 0, 0, lpThreadId);
case WaitForSingleObject(hThread, dwTimeout) of
WAIT_OBJECT_0: Result := TA_SUCCESS_CLEAN;
WAIT_TIMEOUT, WAIT_FAILED: if TerminateProcess(hProc, 0) then Result := TA_SUCCESS_KILL;
end;
finally
CloseHandle(hThread);
end;
end;
finally
CloseHandle(hProc);
end;
until not Process32Next(hProcessSnap, pe32);
finally
Free;
end;
finally
CloseHandle(hProcessSnap);
end;
end;

/////////////////////////////
function IsCheckProcessRunning( const ProcName: String ): Boolean;
begin
Result := not IsProcessRunning( ProcName );
if not Result then
if ( mrYes = MsgBox( Format( '%s "%s" %s'#13#13'%s', ['Процесс', ProcName, 'запущен. Закрыть процесс?', 'Нажатие "Нет" прервет установку.']), mbError, mb_YesNo ) ) then
begin
TerminateApp(ProcName, 5000);
Result := True;
end;
end;

function InitializeSetup(): Boolean;
begin
Result := IsCheckProcessRunning( 'calc.exe' );
end;

[icetanker]

// save dialog
szFileName := ExtractFileName(szURL);
if GetSaveFileName('Сохранить как...', szFileName, '', Format('*%s', [ExtractFileExt(szFileName)]), ExtractFileExt(szFileName)) then
try
hFile := CreateFile(szFileName, GENERIC_READ or GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); //create file
if hFile = 0 then Exit;
hHeap := GetProcessHeap();
lpBuffer := HeapAlloc(hHeap, HEAP_ZERO_MEMORY, 4*1024); // buffer size must be >= 512Kb
ib.dwStructSize := SizeOf(ib);
ib.lpvBuffer := lpBuffer;
ib.dwBufferLength := HeapSize(hHeap, 0, lpBuffer);
как изменить данный блог,чтобы файл сохранялся в определенную директорию???

[saurn]

icetanker, без диалога сохранить как?
http://forum.oszone.net/post-2149509-442.html

[Shkutu]

Всем доброго дня!
Подскажите плиз, вот есть 2 типа установки (полный и выборочный) и компоненты, два из которых взаимоисключающие.
[Types]
Name: "full"; Description: {cm:full}
Name: "custom"; Description: {cm:custom}; Flags: iscustom
[Components]
Name: "srv"; Description: {cm:srv}; Types: full custom;
Name: "srv\k7"; Description: {cm:srvk7}; Types: full custom; Flags: exclusive
Name: "srv\k6"; Description: {cm:srvk6}; Types: full custom; Flags: exclusive
Name: "client"; Description: {cm:client}; Types: full custom

При этом, если на странице выбора компонентов выбирать 1й exclusive компонент, то тип установки получается "выборочный", а если 2й, то "полный". Можно ли как-то это поправить?

[nik1967]

Можно ли как-то это поправить? »
Что именно поправить? Конкретнее.
Name: "srv\k7"; Description: {cm:srvk7}; Types: full custom; Flags: exclusive - почему 2 значения типа сразу? Либо full, либо custom
Name: "srv\k6"; Description: {cm:srvk6}; Types: full custom; Flags: exclusive - почему 2 значения типа сразу? Либо full, либо custom
Name: "client"; Description: {cm:client}; Types: full custom - почему 2 значения типа сразу? Либо full, либо custom

[Shkutu]

nik1967, почему либо-либо? Это компоненты, которые относятся к обоим типам установки. Отличие полного от неполного в том, что при полном выбран _весь_ набор компонентов, а при выборочном какие-то компоненты не выбраны, при этом выбрать можно _любой_.
Теперь попытаюсь еще раз объяснить, в чем проблема. Есть один родительский компонент, у которого 2 дочерних exclusive компонента (грубо говоря 2 варианта реализации одного сервера, которые выбираются в зависимости от условий). Когда мы выбираем все компоненты, включая этот сервер, тип установки доложен быть полным (собственно при отсутствии exclusive так и происходит). Но в данном случае по факту получаем, что при выборе сервера 1го варианта тип не полный, а выборочный (при выборе второго варианта exclusive тип полный). Вопрос в том, как сделать так, чтобы при выборе любого варианта сервера вместе с остальными компонентами, тип установки становился полным.

[Dodakaedr]

как создать ярлык в формате exe, чтобы этот ярлык просто открывал страницу в браузере? »
Можно вот так создать
[Setup]
AppName=TestIcon
AppVersion=1.0
CreateAppDir=no
OutputDir=Ярлык в .exe формате
SetupIconFile=icon.ico

[Code]
function InitializeSetup(): Boolean;
var
rcode: Integer;
begin
ShellExec('', 'www.oszone.net', '', '', SW_SHOW, ewNoWait, rcode);
Result := False;
end;