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

[by_gangster]

habib2302, В качестве иконки ярлыка берется иконка исполняемого файла. »

[El Sanchez]

А в примере от El Sanchez, можно сделать что бы окно выбора не высвечивалось ? »
by_gangster, замените эти строки:

if GetSaveFileName('Сохранить как...', fName, '', '*' + ExtractFileExt(fName), ExtractFileExt(fName)) then
try


вот этими:

if DirExists(szDestDir) then
try
fName := Format('%s\%s', [szDestDir, fName]);


Саму процедуру объявите как:

procedure DownloadFile(urlFilename, szDestDir: String);


P.S. Вообще-то пример в шапке устарел, заменю его как-нибудь.

[Johny777]

by_gangster, El Sanchez,
позволил себе изменить немного процедуру скачивания:

procedure DownloadFile(интернет_ссылка_на_файл, имя_файла_сохранения, указатель_на_каллбэк_процедуру);
упростил немного код, благодаря каллбэку избавился от глобальных переменных и вынес конвертацию массива символов в строку в отдельную функцию и таким макаром избавился от некоторых действий
процедуры скачивания и теперь в функцию передаются не переменные, а const ссылки (так лучше)
пример скачивания и работы каллбэка ниже:


[Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
OutputDir=.
Compression=lzma2/ultra
InternalCompressLevel=ultra
SolidCompression=yes

[code ]

#ifdef UNICODE
#define A "W"
#define UCHAR "AnsiChar"
#else
#define A "A"
#define UCHAR "Char"
#endif

const
INTERNET_OPEN_TYPE_PRECONFIG = 0;
INTERNET_FLAG_NO_CACHE_WRITE = $4000000;
INTERNET_FLAG_NEED_FILE = $10;
INTERNET_FLAG_NO_AUTO_REDIRECT = $200000;
HTTP_QUERY_LOCATION = 33;
FILE_END = 2;
INVALID_SET_FILE_POINTER = $FFFFFFFF;

DOWNLOAD_START = -1;
DOWNLOADING = 1;
DOWNLOAD_END = 0;

type
_DOWNLOAD_CALLBACK = function(const StatusMessage, sFileNameAddr, dwFileSize, dwPosition: Longint): Boolean;
HINTERNET = Longint;

var
StopDownload: Boolean;
StopDownloadBtn: TButton;

function InternetOpen(lpszAgent: String; dwAccessType: DWORD; lpszProxy, lpszProxyBypass: String; dwFlags: DWORD): HINTERNET; external 'InternetOpen{#A}@wininet.dll stdcall';
function InternetOpenUrl(hInet: HINTERNET; lpszUrl, lpszHeaders: String; dwHeadersLength, dwFlags, dwContext: DWORD): HINTERNET; external 'InternetOpenUrl{#A}@wininet.dll stdcall';
function InternetSetFilePointer(hFile: HINTERNET; lDistanceToMove, pReserved: Longint; dwMoveMethod, dwContext: DWORD): DWORD; external 'InternetSetFilePointer@wininet.dll stdcall';
function InternetReadFile(hFile: HINTERNET; var lpBuffer: {#UCHAR}; dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; external 'InternetReadFile@wininet.dll stdcall';
function InternetQueryDataAvailable(hFile: HINTERNET; var lpdwNumberOfBytesAvailable: DWORD; dwFlags, dwContext: DWORD): Boolean; external 'InternetQueryDataAvailable@wininet.dll stdcall';
function InternetCloseHandle(hInet: HINTERNET): BOOL; external 'InternetCloseHandle@wininet.dll stdcall';
function DeleteUrlCacheEntry(lpszUrlName: String): BOOL; external 'DeleteUrlCacheEntryA@wininet.dll stdcall';
function HttpQueryInfo(hRequest: HINTERNET; dwInfoLevel: DWORD; var lpvBuffer: {#UCHAR}; var lpdwBufferLength, lpdwReserved: DWORD): BOOL; external 'HttpQueryInfo{#A}@wininet.dll stdcall';
function StrFormatByteSize64(qdw: Currency; var pszBuf: {#UCHAR}; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64{#A}@shlwapi.dll stdcall';
function StrFromTimeInterval(var pszOut: {#UCHAR}; cchMax: UINT; dwTimeMS: DWORD; digits: Byte): Integer; external 'StrFromTimeInterval{#A}@shlwapi.dll stdcall';
function GetTickCount(): DWORD; external 'GetTickCount@kernel32.dll stdcall';

////////////////////////////////////////////
function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of {#UCHAR};
begin
try
Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
except end;
end;


function TicksToTime(Ticks: DWORD): String;
var
i: Byte;
arr: array [0..31] of {#UCHAR};
begin
for i := 0 to StrFromTimeInterval(arr[0], sizeof(arr), Ticks, 8)-1 do Result := Result + arr[i];
end;


function RoundDword(dwValue: DWORD): DWORD;
begin
dwValue := dwValue or (dwValue shr 1);
dwValue := dwValue or (dwValue shr 2);
dwValue := dwValue or (dwValue shr 4);
dwValue := dwValue or (dwValue shr 8);
dwValue := dwValue or (dwValue shr 16);
Result := dwValue - (dwValue shr 1);
end;


procedure CancelDownloadOnClick(Sender: TObject);
begin
StopDownload := True;
end;


function DownloadProgress(const StatusMessage, sFileNameAddr, dwFileSize, dwPosition: Longint): Boolean;
begin
case StatusMessage of
DOWNLOAD_START:
begin
WizardForm.ProgressGauge.Max := dwFileSize;
StopDownloadBtn := TButton.Create(WizardForm)
with StopDownloadBtn do
begin
Parent := WizardForm;
SetBounds(WizardForm.CancelButton.Left, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width, WizardForm.CancelButton.Height);
Caption := WizardForm.CancelButton.Caption;
OnClick := @CancelDownloadOnClick;
end;
WizardForm.CancelButton.Hide;
end;
DOWNLOADING:
begin
WizardForm.ProgressGauge.Position := dwPosition;
WizardForm.StatusLabel.Caption := Format( 'FileName:' #32 '%s' #32 'FileSize:' #32 '%s', [CastIntegerToString(sFileNameAddr), BytesToSize(Extended(dwFileSize))] );
WizardForm.FilenameLabel.Caption := Format( 'Downloaded:' #32 '%s' #32 'Ready:' #32 '%s', [BytesToSize(Extended(dwPosition)), FormatFloat('0.#0 %', (dwPosition*100)/dwFileSize)] );
Application.ProcessMessages;
end;
DOWNLOAD_END:
begin
WizardForm.CancelButton.Show;
if StopDownloadBtn <> nil then StopDownloadBtn.Free;
end;
end;
// Result := True;
Result := StopDownload;
end;


function CharArrayToString(const cArray: array of Char): String;
var
i: Integer;
begin
for i := 0 to GetArrayLength(cArray)-1 do Result := Result + cArray[i];
end;


procedure DownloadFile(const urlFilename, DestFileName: String; const CallBack: _DOWNLOAD_CALLBACK);
var
lpdwNumberOfBytesRead, lpdwNumberOfBytesAvailable, lpdwBufferLength, lpdwIndex: DWORD;
hInt, hRedir, hFile: HINTERNET;
dStop: Boolean;
lpBuffer: array of {#UCHAR};
fStream: TFileStream;
fSize: DWORD;
begin
hInt := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, '', '', 0);
if hInt <> 0 then
try
//Get file size
hRedir := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE or INTERNET_FLAG_NO_AUTO_REDIRECT, 0);
if hRedir <> 0 then
try
SetArrayLength(lpBuffer, 1024);
fSize := InternetSetFilePointer(hRedir, 0, 0, FILE_END, 0);
if fSize = INVALID_SET_FILE_POINTER then
begin
lpdwBufferLength := GetArrayLength(lpBuffer);
lpdwIndex := 0;
HttpQueryInfo(hRedir, HTTP_QUERY_LOCATION, lpBuffer[0], lpdwBufferLength, lpdwIndex);
hFile := InternetOpenUrl(hInt, CharArrayToString(lpBuffer), '', 0, INTERNET_FLAG_NEED_FILE, 0);
if hFile <> 0 then
try
fSize := InternetSetFilePointer(hFile, 0, 0, FILE_END, 0);
finally
InternetCloseHandle(hFile);
DeleteUrlCacheEntry(urlFilename);
end;
end;
finally
InternetCloseHandle(hRedir);
DeleteUrlCacheEntry(urlFilename);
end;
// download

if FileExists(DestFileName) then if not DeleteFile(DestFileName) then
begin
InternetCloseHandle(hInt);
Exit;
end;
if not DirExists(ExtractFileDir(DestFileName)) then if not ForceDirectories(ExtractFileDir(DestFileName)) then
begin
InternetCloseHandle(hInt);
Exit;
end;

hFile := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE, 0);
if hFile <> 0 then
try
fStream := TFileStream.Create(DestFileName, fmCreate);

if CallBack <> nil then dStop := CallBack( DOWNLOAD_START, CastStringToInteger(DestFileName), Longint(fSize), 0);
while (InternetQueryDataAvailable(hFile, lpdwNumberOfBytesAvailable, 0, 0) and (lpdwNumberOfBytesAvailable > 0)) and not dStop do
begin
SetArrayLength(lpBuffer, RoundDword(lpdwNumberOfBytesAvailable));
InternetReadFile(hFile, lpBuffer[0], GetArrayLength(lpBuffer), lpdwNumberOfBytesRead);
fStream.WriteBuffer(CharArrayToString(lpBuffer), lpdwNumberOfBytesRead);
fStream.Seek(0, soFromEnd);
if CallBack <> nil then dStop := CallBack(DOWNLOADING, CastStringToInteger(DestFileName), Longint(fSize), Longint(fStream.Size + lpdwNumberOfBytesRead));
end;
finally
fStream.Free;
InternetCloseHandle(hFile);
DeleteUrlCacheEntry(urlFilename);
if CallBack <> nil then dStop := CallBack( DOWNLOAD_END, CastStringToInteger(DestFileName), Longint(fSize), 0);
if dStop then DeleteFile(DestFileName);
end;
finally
InternetCloseHandle(hInt);
end;
end;


procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then DownloadFile('http://mse.dlservice.microsoft.com/download/7/6/0/760B9188-4468-4FAD-909E-4D16FE49AF47/ruRU/x86/mseinstall.exe', ExpandConstant('{app}\File.exe'), @DownloadProgress); // ..., nil); - no Callback
end;





надеюсь не накосячил
и ещё есть поддержка юникодной инно и кнопка отмены

[by_gangster]

Johny777, Ага только процедуру отмениь нельзя (кнопочкой) когда начинается скачивание...

Johny777, И ещё, почему нельзя так делать ?
begin
if CurStep = ssInstall then DownloadFile('http://sayt.ru/1.rar', '{app}\File.exe', @DownloadProgress); // ..., nil); - no Callback
end;

[habib2302]

В качестве иконки ярлыка берется иконка исполняемого файла. »
может что-то можно дописать в vbs скрипт

[Johny777]

by_gangster,
процедуру отмениь нельзя (кнопочкой) когда начинается скачивание »
добавил кнопку отменны, в перед. сообщении
И ещё, почему нельзя так делать ? »
И что это по твоему за путь '{app}\File.exe' ?
так нельзя, тк {app} - константа. Такую строку нужно пропускать через функцию ExpandConstant(...), которая заменяет константы на пути
короче нужно вот так DownloadFile('http://sayt.ru/1.rar', ExpandConstant('{app}\File.exe'), @DownloadProgress);

[by_gangster]

Johny777, Выскакивает ошибка

Cannot create file D:\new\1.rar

[Johny777]

by_gangster, без понятия, у меня всё в порядке. Посмотри в дебаггере на какой строке вылетает. К тому же что касается непосредственно скачивания я ничего не менял, так что ошибок быть не должно
предположу что файлстрим не может создать файл, тк он существует и его держит какой-то процесс
или папка "new" в пути "D:\new\1.rar" не существует (скорее всего именно из-за этого ошибка), исправил пост, пробуй

[by_gangster]

Johny777, Сейчас всё нормально... но деинсталлятор не удаляет файл...

[saurn]

Johny777, Сейчас всё нормально... но деинсталлятор не удаляет файл... »
[UninstallDelete]
Name: {app}\1.rar; Type: files
или
[UninstallDelete]
Name: {app}\*; Type: filesandordirs

[by_gangster]

saurn, Ну я и нуб, как я сразу не понял... :sorry:

[by_gangster]

Может кому-нибудь пригодится полезный скрипт.

Перед запуском инсталлятор проверяет на наличие необходимой программы через реестр... В данном случае это игра S.T.A.L.K.E.R Зов Припяти

function InitializeSetup(): Boolean;
begin
Result:=True;
If (not RegKeyExists(HKLM, 'Software\GSC Game World\STALKER-COP')) then
begin
MsgBox('Не установлена игра S.T.A.L.K.E.R Зов Припяти', mbError, mb_Ok);
Result:=False;
end;
end;

[saurn]

by_gangster, можно эффективней, проверить наличие ветки реестра и одновременно наличие некоего файла в папке с игрой(в данном случае ексишника деинсталятора), на случай, если папку с игрой снесли, а хвосты в реестре остались:
function InitializeSetup(): Boolean;
begin
Result := FileExists(RemoveQuotes(ExpandConstant('{reg:HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstal l\S.T.A.L.K.E.R._is1,UninstallString}')));
if not Result then MsgBoxEx(0, 'Игра не установлена.', 'Игра не установленна', MB_OK or MB_ICONWARNING, 0, 0)
end;

[by_gangster]

Скажите пожалуйста как в этом (http://forum.ru-board.com/topic.cgi?forum=5&topic=30413&start=2562&limit=1&m=12#1) примере можно изменить шрифт ?

[Mailchik]

by_gangster, Font.Name := 'бла-бла-бла;
---------------------------------------------------------------------------------------------------------------------------------------
Может кому-нибудь пригодится полезный скрипт.
Перед запуском инсталлятор проверяет на наличие необходимой программы через реестр »
Если бы вы читали форумы по инно - здесь на oszone или на ру-борде, вы бы поняли, что эти строчки кода уже перепереезженные, и имеются во всех возможных FAQ'ах к инно. Но нет, вы умеете только орать, дайте мне то, дайте мне это....

[by_gangster]

вы умеете только орать »
Кто орал то ?

[saurn]

Всем привет. Вопрос к знатокам: имеется куча чекбоксов и чтобы не плодить такую же прорву булевных функций думал, как объединить их все в одну, при этом не записывая значения с каждого в отдельную глобальную переменную. Короче, в итоге сваял:
[Code]
function CheckedBoxes(const cNumber: Integer): Boolean;
begin
case cNumber of
1: Result := CheckBox_1.Checked;
2: Result := CheckBox_2.Checked;
3: Result := CheckBox_3.Checked;
4: Result := CheckBox_4.Checked;
5: Result := CheckBox_5.Checked;
6: Result := CheckBox_6.Checked;
7: Result := CheckBox_7.Checked;
8: Result := CheckBox_8.Checked;
end;
end;

//ну и проверка:

if CheckedBoxes(1) then
if CheckedBoxes(2) then
if CheckedBoxes(3) then
... и т.д.

Обработка проходит корректно, но это можно назвать правильным, или меня куда-то не туда понесло(знаю, что можно использовать чеклистбокс, но как-то удобней мне с простыми чекбоксами)?

[Johny777]

saurn, Осваивай массивы (статичные и динамичные) и работу с ними, мелкий пример:


[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[code ]
var
CheckArray: array of TCheckBox; // array [0..16] of TCheckBox;


function IndexOfCheckBox(const UCaption: String): Integer;
var
i: Integer;
begin
Result := -1;
for i := GetArrayLength(CheckArray)-1 downto 0 do if CheckArray[i].Caption = UCaption then
begin
Result := i;
Break;
end;
end;


function CaptionOfCheckBox(const UIndex: Integer): String;
var
i: Integer;
begin
for i := 0 to GetArrayLength(CheckArray)-1 do if i = UIndex then Result := CheckArray[i].Caption;
end;

function IsChecked(const UIndex: Integer): Boolean;
var
i: Integer;
begin
if UIndex > GetArrayLength(CheckArray)-1 then Exit;
Result := CheckArray[UIndex].Checked;
end;


procedure InitializeWizard();
var
i: Integer;
begin
WizardForm.OuterNotebook.Hide;

SetArrayLength(CheckArray, 16);

CheckArray[0] := TCheckBox.Create(WizardForm)
with CheckArray[0] do
begin
Parent := WizardForm;
Left := ScaleX(7);
Top := ScaleY(7);
Caption := IntToStr(0);
end;
for i := 1 to GetArrayLength(CheckArray)-1 do
begin
CheckArray[i] := TCheckBox.Create(WizardForm)
with CheckArray[i] do
begin
Parent := WizardForm;
Left := ScaleX(7);
Top := ScaleY(CheckArray[i-1].Top + 16);

if i mod 2 = 0 then Checked := True;

Caption := IntToStr(i);
end;
end;

///
if IsChecked(10) then MsgBox('Checked', mbInformation, MB_OK);
MsgBox(CaptionOfCheckBox(5), mbInformation, MB_OK);
MsgBox(IntToStr( IndexOfCheckBox('7') ), mbInformation, MB_OK);
end;

[Dinvin4ester]

Ребят , а что делать если ошибку выдает :( - http://i47.fastpic.ru/big/2013/0515/7a/5cd153eb889805668503b12bfcb45e7a.png
Хочу подкоректировать этот скрипт - http://rghost.ru/46018269 - need-for-speedtm-hot-pursuit-1.5 (самый простой, так сказать для начинающих) :)
И да мне бы только код оформления выдернуть , а если нет подкорректировать - просто хочу инсталлы свои делать .Надеюсь на вашу помощь .

[saurn]

Dinvin4ester, это ошибка ISDone. Означает, что не заданно ни одного архива *.arc для распаковки. Есть в скрипте секция, где задается, какой архив распаковывать, куда распаковывать, и местоположение архива соответственно.
if not ISArcExtract ( 0, 0, ExpandConstant('{src}\data.bin'), ExpandConstant('{app}'), false, '', '', ExpandConstant('{app}'), notPCFonFLY {PCFonFLY}) then break;
Тут вам лучше почитать справку к ISDone, она есть в архиве со скриптом. Там все подробно расписанно. Если же нужно только оформление и сжатие внутренними средствами инно, и функции ISDone не нужны соответственно, могу убрать из скрипта ISDone.