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

[Diesel123denpda]

R.i.m.s.k.y. спасибо за такой ответ, но я имел в виду, чтобы инсталлятор при проверке версии через реестр выдавал ошибку о не совпадении версий или предлагал удалить старую версию.

И ещё, народ помогите разобраться вот с этим кодом, подкиньте пример! Заранее спасибо!



[Code]
function InitializeSetup(): Boolean;
var
ResultCode: Integer;
s, ResultStr:string;
begin
Result:=True;
If not RegKeyExists(HKLM, 'SOFTWARE\GSC Game World\STALKER-SHOC\')
then
begin
MsgBox('S.T.A.L.K.E.R Тени Чернобыля v 1.0005 не установлен или установлен неверно.' #13#13 'Дальнейшая работа мастера невозможна.', mbError, mb_Ok);
Result:=False;
end
else
begin
If RegQueryStringValue(HKLM, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\','UninstallString', ResultStr)
then
begin
If ResultStr<>''
then
begin
ResultStr:=RemoveQuotes(ResultStr); if MsgBox('Программа установки обнаружила уже установленную программу ранней версии.' #13#13 'Вы желаете предварительно удалить ее?', mbInformation, MB_YESNO) = idYes
then
if not Exec(ResultStr, '', '', SW_SHOWNORMAL, ewWaitUntilTerminated, ResultCode)
then
MsgBox('Ошибка удаления. ' #13#13 '' + SysErrorMessage(ResultCode) + '.' #13#13 'Вероятно, деинсталлятор был перемещен, удален или переименован.', mbError, MB_OK);
end;
end;
end;
end;

[dracosha]

И снова здравствуйте!
Опять назрел вопрос:

function IsPreviousVersionUpdatable(): Boolean;
var
version, major, minor, build, revis: string;
begin
Result := false;
if RegQueryStringValue(HKLM, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + GetAppID('') + '_is1', 'DisplayVersion', version) then
begin
major := Copy(version, 0, Pos('.', version) - 1);
Delete(version, 1, Pos('.', version));
minor := Copy(version, 0, Pos('.', version) - 1);
Delete(version, 1, Pos('.', version));
build := Copy(version, 0, Pos('.', version) - 1);
Delete(version, 1, Pos('.', version));
revis := Copy(version, 0, Pos('.', version) - 1);
Delete(version, 1, Pos('.', version));
if CompareStr(major, ExpandConstant('{#MyAppVerMajor}')) = 0 then
if CompareStr(minor, ExpandConstant('{#MyAppVerMinor}')) = 0 then
if CompareStr(build, ExpandConstant('{#MyAppVerBuild}')) >= 0 then
if CompareStr(revis, ExpandConstant('{#MyAppVerRevis}')) >= 0 then
Result := true;
end;
end;

Господа ГУРУ! Помогите пожалуйста исправить этот код что бы получилось примерно следующее:
1. Если в системе установлена версия 0.0.5.5 то старая версия 0.0.4.4 была равна false.
2. Если в системе установлена версия 0.0.5.5 то новая версия 1.1.0.0 была равна false.
3. Если в системе установлена версия 0.0.5.5 то новая версия 0.0.6.6 была равна true.

т.е. мне хотелось бы что б при обновлении Major или Minor обновление было не доступно, а если в версии обновлены только Build и Revis, а Major и Minor не обновлялись то обновление было доступно
Serega, помоги пожалуйста?

[semiono]

Есть ли возможность InnoSetup узнать размеры экрана десктопа текущего?

[nik1967]

R.i.m.s.k.y.,
А не пробовал без "Wow6432Node" в строке реестра? Не знаю, у кого как, а у меня винда сама закидывает в реестре куда надо.
к примеру
Root: HKLM; SubKey: SOFTWARE\GNU\ffdshow; ValueType: string; ValueName: pth; ValueData: {app}\FFDShow; Flags: uninsdeletevalue deletevalue; Check: not IsWin64; Components: ffd
Root: HKLM; SubKey: SOFTWARE\GNU\ffdshow64; ValueType: string; ValueName: pth; ValueData: {app}\FFDShow64; Flags: uninsdeletevalue deletevalue; Check: IsWin64; Components: ffd

[nik1967]

semiono, [Setup]
AppName=DisplayResoltution
AppVerName=DisplayResoltution
DefaultDirName=DisplayResoltution
DisableStartupPrompt=true
Uninstallable=false
InternalCompressLevel=none
Compression=none

[_Code]
//functions to get BPP & resolution

//
// prototype for ISX 3.X
//
function DeleteDC(hDC: Integer): Integer; external 'DeleteDC@GDI32 stdcall';
function CreateDC(lpDriverName, lpDeviceName, lpOutput: String; lpInitData: Integer): Integer; external 'CreateDCA@GDI32 stdcall';
function GetDeviceCaps(hDC, nIndex: Integer): Integer; external 'GetDeviceCaps@GDI32 stdcall';

Const
HORZRES = 8; //horizontal resolution
VERTRES = 10; //vertical resolution
BITSPIXEL = 12; //bits per pixel
PLANES = 14; //number of planes (color depth=bits_per_pixel*number_of_planes)

function InitializeSetup(): Boolean;
var xres, yres, bpp, pl, tmp: Integer;
hDC: Integer;
begin
//get resolution & BPP
hDC := CreateDC('DISPLAY', '', '', 0);
pl := GetDeviceCaps(hDC, PLANES);
bpp := GetDeviceCaps(hDC, BITSPIXEL);
xres := GetDeviceCaps(hDC, HORZRES); //horizontal resolution
yres := GetDeviceCaps(hDC, VERTRES); //vertical resolution
// tmp := DeleteDC(hDC);
bpp := pl * bpp; //color depth

MsgBox( 'Current resolution is ' + IntToStr(xres) +
'x' + IntToStr(yres) +
' and color depth is ' + IntToStr( bpp )
, mbInformation, MB_OK );

Result := false;
end;

[R.i.m.s.k.y.]

А не пробовал без "Wow6432Node" »
Нет, не пробовал, попробую

[nik1967]

R.i.m.s.k.y.,
И ещё обрати внимание на Check: not IsWin64 для x32 и Check: IsWin64 для x64.

[Serega]

что б при обновлении Major или Minor обновление было не доступно, а если в версии обновлены только Build и Revis, а Major и Minor не обновлялись то обновление было доступно »
Если я правильно понял, то так:

const
MyAppVerMajor = 1;
MyAppVerMinor = 2;
MyAppVerBuild = 3;
MyAppVerRevis = 4;

function IsPreviousVersionUpdatable(): Boolean;
var
version: string;
major, minor, build, revis: Integer;
begin
Result := False;
if RegQueryStringValue(HKLM, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + GetAppID('') + '_is1', 'DisplayVersion', version) then
begin
major := StrToInt(Copy(version, 1, Pos('.', version) - 1));
Delete(version, 1, Pos('.', version));

minor := StrToInt(Copy(version, 1, Pos('.', version) - 1));
Delete(version, 1, Pos('.', version));

build := StrToInt(Copy(version, 1, Pos('.', version) - 1));
Delete(version, 1, Pos('.', version));

revis := StrToInt(Copy(version, 1, Pos('.', version) - 1));
Delete(version, 1, Pos('.', version));

if (major <= MyAppVerMajor) and (minor <= MyAppVerMinor) then
Result:= (build < MyAppVerBuild) or (revis < MyAppVerRevis);
end;
end;

Сразу замечание по коду, строка начинается с 1, а массивы обычно с 0, т.е.:
major := Copy(version, 0, Pos('.', version) - 1); »
грубейшая ошибка, копировать можно только с первого символа!

[R.i.m.s.k.y.]

И ещё обрати внимание на Check: not IsWin64 для x32 и Check: IsWin64 для x64 »
Первым делом расставил, думал этим и ограничится дело.

[SkarM]

Хотел спросить: как с помощью Inno setup можно создать инсталятор драйверов? Если есть собственно только сами распакованные файлы драйвера.

[R.i.m.s.k.y.]

Хотел спросить: как с помощью Inno setup можно создать инсталятор драйверов? »
Я думаю рискованно, драйвер пишется во многие секции реестра, да еще в зависимости от карты, ОС, фазы луны... Думаю лучше распаковать и сделать тихую установку (попробовать с параметром /Q, /silent), если драйвер вообще поддерживает тихую установку.

[SkarM]

Тоесть? Это как?У меня есть только уже распакованные файлы, и нужно сделать чтоб можно было его каким-угодно образом установить на другом компе... :dont-know

[R.i.m.s.k.y.]

Тоесть? Это как?У »
В папке с распакованными драйверами есть setup.exe, запустите его с параметром /Q или /silent. Поможет если инсталлер поддерживает тихую установку. Пару страниц назад я давал пример для PhysX (ищите по PsysX - я тогда ошибся в написании)

[SkarM]

http://s16.radikal.ru/i191/1008/68/9681f231d9e1t.jpg (http://radikal.ru/F/s16.radikal.ru/i191/1008/68/9681f231d9e1.jpg.html)

Есть только эти.

[R.i.m.s.k.y.]

Есть только эти »
Запускать на установку надо sbusd.inf. Запуск установки inf из командной строки
rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 .\<file>.inf

[SeDmY]

Доброго времени суток! Помогите плиз вытащить скрипт, который будет отвечать только за оформление инсталятора, а точнее за то, чтобы поставить картинку на фоне из этого: http://rghost.ru/2275693

Хочу прицепить к своему, а в этом для меня слишком много ненужного хлама, да и скин не нужен...

Сделать типа этого:

http://imagepost.ru/thumbs/186/R5R9lSkLKLjD.PNG (http://imagepost.ru/?v=186/R5R9lSkLKLjD.PNG)

[SkarM]

У меня стоит Inno Setup 5.3.4, использую скрипт для распаковки .arc версии 3.5(с шапки), и всеравно вылетает ошибка на этой строке:
#ifdef UNICODE ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup

Вот сам код, может там где-то что-то не правильно:
; Script generated by the Inno Setup Script Wizard.
; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES!

[Setup]
; NOTE: The value of AppId uniquely identifies this application.
; Do not use the same AppId value in installers for other applications.
; (To generate a new GUID, click Tools | Generate GUID inside the IDE.)
AppId={{3696E971-EDA3-4A4E-950C-D5DD5D4166C0}
AppName=My Program
AppVerName=My Program 1.5
AppPublisher=My Company, Inc.
AppPublisherURL=http://www.example.com/
AppSupportURL=http://www.example.com/
AppUpdatesURL=http://www.example.com/
DefaultDirName=345\My Program d:\програмирование\Инсталяторы\New project\data\installfiles\
DefaultGroupName=My Program
OutputDir=D:\програмирование\Инсталяторы\New project
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes

[Files]
;Source: *.arc; DestDir: {app}; Flags: nocompression
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy deleteafterinstall
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: d:\програмирование\Инсталяторы\New project\data\installfiles\1.arc; DestDir: {app}; Flags: external dontcopy; Components: 1\one
Source: d:\програмирование\Инсталяторы\New project\data\installfiles\2.arc; DestDir: {app}; Flags: external dontcopy; Components: 1\two
Source: d:\програмирование\Инсталяторы\New project\data\installfiles\3.arc; DestDir: {app}; Flags: external dontcopy; Components: 1\three
Source: d:\програмирование\Инсталяторы\New project\data\installfiles\4.arc; DestDir: {app}; Flags: external dontcopy; Components: 1\four



[Components]
name: 1; Description: Основные файлы; Flags: fixed; Types:full
name: 1\one; Description: ««Немецкая озвучка наёмников»»; Flags: dontinheritcheck; Types:full
name: 1\two; Description: ««Украинская озвучка бандитов»»; Flags: dontinheritcheck; Types:full
name: 1\three; Description: ««Прозрачный инвентарь»»; Flags: dontinheritcheck; Types:full
name: 1\four; Description: ««Новая погода»»; Flags: dontinheritcheck; Types:full compact

[Languages]
Name: "russian"; MessagesFile: "compiler:Languages\Russian.isl"

[CustomMessages]
rus.ArcBreak=Установка прервана!
rus.ExtractedInfo=Распаковано %1 Мб из %2 Мб
rus.ArcInfo=Архив: %1 из %2
rus.ArcTitle=Распаковка архивов FreeArc
rus.ArcError=Распаковщик FreeArc вернул код ошибки: %1
rus.ArcFail=Распаковка не завершена!
rus.AllProgress=Общий прогресс распаковки: %1%%
rus.ArcBroken=Возможно, архив %1 повреждён%nили недостаточно места на диске назначения.
rus.Extracting=Распаковывается: %1
rus.taskbar=%1%%, жди %2
rus.remains=Осталось ждать %1
rus.LongTime=вечно
rus.ending=завершение
rus.hour= часов
rus.min= мин
rus.sec= сек

[UninstallDelete]
Type: filesandordirs; Name: {app}

[Code]
const
Archives = 'd:\програмирование\Инсталяторы\New project\data\installfiles\*.arc'; // укажите расположение архивов FreeArc; для внешних файлов строку в [Files] добавлять необязательно

PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMb = 1048576;

type
#ifdef UNICODE ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup
#define A "W"
#else
#define A "A" ; точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
PAnsiChar = PChar; // Required for Inno Setup 5.3.0 and higher. (требуется для Inno Setup версии 5.3.0 и ниже)
#endif
#if Ver < 84018176
AnsiString = String; // There is no need for this line in Inno Setup 5.2.4 and above (для Inno Setup версий 5.2.4 и выше эта строка не нужна)
#endif

TMyMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;

TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path: string; OrigSize: Integer; Size: Extended; end;

var
ExtractFile: TLabel;
lblExtractFileName: TLabel;
btnCancelUnpacking: TButton;
CancelCode, n, UnPackError, StartInstall: Integer;
Arcs: array of TArc;
msgError: string;
lastMb: Integer;
baseMb: Integer;
totalUncompressedSize: Integer; // total uncompressed size of archive data in mb
LastTimerEvent: DWORD;

Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: string; cbMultiByte: integer; lpWideCharStr: string; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: string; cchWideChar: integer; lpMultiByteStr: string; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

function PeekMessage(var lpMsg: TMyMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMyMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMyMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';

Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';

function GetTickCount: DWord; external 'GetTickCount@kernel32';
function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl';

procedure AppProcessMessage;
var
Msg: TMyMsg;
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;

// Перевод числа в строку с точностью 3 знака (%.3n) с округлением дробной части, если она есть
Function NumToStr(Float: Extended): String;
Begin
Result:= Format('%.3n', [Float]); StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Length(Result) > 1) do
SetLength(Result, Length(Result)-1);
End;

function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;

Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo;
if Lo<0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
for Hi:= Hi-1 Downto 0 do
Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;

// Converts OEM encoded string into ANSI
// Преобразует OEM строку в ANSI кодировку
function OemToAnsiStr( strSource: AnsiString): AnsiString;
var
nRet : longint;
begin
SetLength( Result, Length( strSource ) );
nRet:= OemToChar( strSource, Result );
end;

// Converts ANSI encoded string into UTF-8
// Преобразует строку из ANSI в UTF-8 кодировку
function AnsiToUtf8( strSource: string ): string;
var
nRet : integer;
WideCharBuf: string;
MultiByteBuf: string;
begin
strSource:= strSource + chr(0);
SetLength( WideCharBuf, Length( strSource ) * 2 );
SetLength( MultiByteBuf, Length( strSource ) * 2 );

nRet:= MultiByteToWideChar( CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf) );
nRet:= WideCharToMultiByte( CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);

Result:= MultiByteBuf;
end;

// OnClick event function for btnCancel
procedure btnCancelUnpackingOnClick(Sender: TObject);
begin
if MsgBox( SetupMessage( msgExitSetupMessage ), mbInformation, MB_YESNO ) = IDYES then
CancelCode:= -127;
end;

var origsize: Integer;
// The callback function for getting info about FreeArc archive
function FreeArcInfoCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
begin
if string(what)='origsize' then origsize := Mb else
if string(what)='compsize' then else
if string(what)='total_files' then else
Result:= CancelCode;
end;

// Returns decompressed size of files in archive
function ArchiveOrigSize(arcname: string): Integer;
var
callback: longword;
Begin
callback:= WrapFreeArcCallback(@FreeArcInfoCallback,4); //FreeArcInfoCallback has 4 arguments
CancelCode:= 0;
AppProcessMessage;
try
// Pass the specified arguments to 'unarc.dll'
Result:= FreeArcExtract (callback, 'l', '--', AnsiToUtf8(arcname), '', '', '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
if Result >= 0 then Result:= origsize;
except
Result:= -63; // ArcFail
end;
end;

// Scans the specified folders for archives and add them to list
function FindArcs(dir: string): Extended;
var
FSR: TFindRec;
Begin
Result:= 0;
if FindFirst(ExpandConstant(dir), FSR) then begin
try
repeat
// Skip everything but the folders
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
n:= GetArrayLength(Arcs);
// Expand the folder list
SetArrayLength(Arcs, n +1);
Arcs[n].Path:= ExtractFilePath(ExpandConstant(dir)) + FSR.Name;
Arcs[n].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Result:= Result + Arcs[n].Size;
Arcs[n].OrigSize := ArchiveOrigSize(Arcs[n].Path)
totalUncompressedSize := totalUncompressedSize + Arcs[n].OrigSize
until not FindNext(FSR);
finally
FindClose(FSR);
end;
end;
End;

// Sets the TaskBar title
Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
h:= GetWindowLong(MainForm.Handle, -8); if h <> 0 then SetWindowText(h, Title);
End;

// Converts milliseconds to human-readable time
// Конвертирует милисекунды в человеко-читаемое изображение времени
Function TicksToTime(Ticks: DWord; h,m,s: String; detail: Boolean): String;
Begin
if detail {hh:mm:ss format} then
Result:= PADZ(IntToStr(Ticks/3600000), 2) +':'+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +':'+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2)
else if Ticks/3600 >= 1000 {more than hour} then
Result:= IntToStr(Ticks/3600000) +h+' '+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +m
else if Ticks/60 >= 1000 {1..60 minutes} then
Result:= IntToStr(Ticks/60000) +m+' '+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2) +s
else Result:= IntToStr(Ticks/1000) +s {less than one minute}
End;

// The main callback function for unpacking FreeArc archives
function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
percents, Remaining: Integer;
s: String;
begin
if GetTickCount - LastTimerEvent > 1000 then begin
// This code will be executed once each 1000 ms (этот код будет выполняться раз в 1000 миллисекунд)
// ....
// End of code executed by timer
LastTimerEvent := LastTimerEvent+1000;
end;

if string(what)='filename' then begin
// Update FileName label
lblExtractFileName.Caption:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
end else if (string(what)='write') and (totalUncompressedSize>0) and (Mb>lastMb) then begin
// Assign to Mb *total* amount of data extracted to the moment from all archives
lastMb := Mb;
Mb := baseMb+Mb;

// Update progress bar
WizardForm.ProgressGauge.Position:= Mb;

// Show how much megabytes/archives were processed up to the moment
percents:= (Mb*1000) div totalUncompressedSize;
s := FmtMessage(cm('ExtractedInfo'), [IntToStr(Mb), IntToStr(totalUncompressedSize)]);
if GetArrayLength(Arcs)>1 then
s := s + '. '+FmtMessage(cm('ArcInfo'), [IntToStr(n+1), IntToStr(GetArrayLength(Arcs))])
ExtractFile.Caption := s

// Calculate and show current percents
percents:= (Mb*1000) div totalUncompressedSize;
s:= FmtMessage(cm('AllProgress'), [Format('%.1n', [Abs(percents/10)])]);
if Mb > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((totalUncompressedSize - Mb)/Mb)) else Remaining:= 0;
if Remaining = 0 then SetTaskBarTitle(cm('ending')) else begin
s:= s + '. '+FmtMessage(cm('remains'), [TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)])
SetTaskBarTitle(FmtMessage(cm('taskbar'), [IntToStr(percents/10), TicksToTime(Remaining, 'h', 'm', 's', false)]))
end;
WizardForm.FileNameLabel.Caption := s
end;
AppProcessMessage;
Result:= CancelCode;
end;

// Extracts all found archives
function UnPack(Archives: string): Integer;
var
totalCompressedSize: Extended;
callback: longword;
FreeMB, TotalMB: Cardinal;
begin
// Display 'Extracting FreeArc archive'
lblExtractFileName.Caption:= '';
lblExtractFileName.Show;
ExtractFile.caption:= cm('ArcTitle');
ExtractFile.Show;
// Show the 'Cancel unpacking' button and set it as default button
btnCancelUnpacking.Caption:= WizardForm.CancelButton.Caption;
btnCancelUnpacking.Show;
WizardForm.ActiveControl:= btnCancelUnpacking;
WizardForm.ProgressGauge.Position:= 0;
// Get the size of all archives
totalUncompressedSize := 0;
totalCompressedSize := FindArcs(Archives);
WizardForm.ProgressGauge.Max:= totalUncompressedSize;
// Other initializations
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
StartInstall:= GetTickCount; {время начала распаковки}
LastTimerEvent:= GetTickCount;
baseMb:= 0

for n:= 0 to GetArrayLength(Arcs) -1 do
begin
lastMb := 0
CancelCode:= 0;
AppProcessMessage;
try
// Pass the specified arguments to 'unarc.dll'
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', AnsiToUtf8(Arcs[n].Path), '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;
baseMb:= baseMb+lastMb

// Error occured
if Result <> 0 then
begin
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
GetSpaceOnDisk(ExtractFileDrive(ExpandConstant('{app}')), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < 32 {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Arcs[n].Path)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
// MsgBox(msgError, mbInformation, MB_OK); //сообщение показывается на странице завершения
Log(msgError);
Break; //прервать цикл распаковки
end;
end;
// Hide labels and button
WizardForm.FileNameLabel.Caption:= '';
lblExtractFileName.Hide;
ExtractFile.Hide;
btnCancelUnpacking.Hide;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
UnPackError:= UnPack(Archives)
if UnPackError = 0 then
SetTaskBarTitle(SetupMessage(msgSetupAppTitle))
else
begin
// Error occured, uninstall it then
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); //откат установки из-за ошибки unarc.dll
SetTaskBarTitle(SetupMessage(msgErrorTitle))
WizardForm.Caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
end;
end;
end;

// стандартный способ отката (не нужна CurPageChanged), но архивы распаковываются до извлечения файлов инсталлятора
// if CurStep = ssInstall then
// if UnPack(Archives) <> 0 then Abort;

Procedure CurPageChanged(CurPageID: Integer);
Begin
if (CurPageID = wpFinished) and (UnPackError <> 0) then
begin // Extraction was unsuccessful (распаковщик вернул ошибку)
// Show error message
WizardForm.FinishedLabel.Font.Color:= $0000C0; // red (красный)
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + msgError;
end;
End;

procedure InitializeWizard();
begin
with WizardForm.ProgressGauge do
begin
// Create a label to show current FileName being extracted
lblExtractFileName:= TLabel.Create(WizardForm);
lblExtractFileName.parent:=WizardForm.InstallingPage;
lblExtractFileName.autosize:=false;
lblExtractFileName.Width:= Width;
lblExtractFileName.top:=Top + ScaleY(35);
lblExtractFileName.Caption:= '';
lblExtractFileName.Hide;

// Create a label to show percentage
ExtractFile:= TLabel.Create(WizardForm);
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width:= Width;
ExtractFile.top:=lblExtractFileName.Top + ScaleY(16);
ExtractFile.caption:= '';
ExtractFile.Hide;
end;

// Create a 'Cancel unpacking' button and hide it for now.
btnCancelUnpacking:=TButton.create(WizardForm);
btnCancelUnpacking.Parent:= WizardForm;
btnCancelUnpacking.SetBounds(WizardForm.CancelButton.Left, WizardForm.CancelButton.top, WizardForm.CancelButton.Width, WizardForm.CancelButton.Height);
btnCancelUnpacking.OnClick:= @btnCancelUnpackingOnClick;
btnCancelUnpacking.Hide;
end;

[R.i.m.s.k.y.]

SkarM,
На прошлой странице выкладывали папку инно. Мне помогло, скачайте и распакуйте в папку установки Inno.

[tupica]

Подскажите пожалуйста, как сделать деинсталлятор с выбором деинсталируемых компонентов.Т.е Установил птичками например CCleaner,Deragler,Speccy.Потом нужно удалить только Defragler, чтобы остальные остались.

Попробую.Теоретически всё правильно, только немного портит вид 3 проги и 3 деинсталлятора в папке(хочу чтобы удалять можно было из пуска).А так Спасибо!

[R.i.m.s.k.y.]

Подскажите пожалуйста, как сделать деинсталлятор с выбором деинсталируемых компонентов. »
Интересный вопрос. Штатной такой особенности я не видел. Напишите на форуме разрабов инно - может добавят.
Я бы сделал такой деинсталлер как еще один инсталлер инно, который вытирал бы файлы и ключи реестра без добавления записей в секцию "установки программ".
Для затравки способ поубирать все ненужные окна (из коллекции скриптов в шапке темы)

Попробовать в разделе [Setup] выставить разные DisableProgramGroupPage=yes, DisableDirPage=yes, DisableFinishedPage=yes, DisableReadyPage=yes, DisableStartupPrompt=yes. Выбирай, что из этого нужно.
Если надо, чтобы совсем без диалогов, щелкнул по сетапу и все, то:

[Setup]
AppName=My Program
AppVerName=My Program 1.5
DefaultDirName={pf}\My Program
DisableDirPage=yes
DisableProgramGroupPage=yes
DisableReadyPage=yes
DisableFinishedPage=yes
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes


[Files]
Source: "C:\My Program\*"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs

[_Code]
procedure CurPageChanged(CurPageID: Integer);
begin
If CurPageID=wpWelcome then
begin
SendMessage(WizardForm.NEXTBUTTON.Handle, 513, 0, 0)
SendMessage(WizardForm.NEXTBUTTON.Handle, 514, 0, 0)
end;
end;


В секцию [Setup] надо дописать Uninstallable=false - прожка не появится в секции "установка и удаление программ"