Ru-Board.club
← Вернуться в раздел «Программы»

» Inno Setup (создание инсталяционных пакетов)

Автор: troyan90
Дата сообщения: 12.08.2010 13:06
TonyJef
делай в AMS
Ссылка
Автор: ChanVS
Дата сообщения: 12.08.2010 13:06
TonyJef
[more]
[Setup]
AppName=AutoRUN
VersionInfoDescription=AutoRUN
VersionInfoProductName=AutoRUN
AppVerName=AutoRUN
VersionInfoProductVersion=1.0.0.0
VersionInfoVersion=1.0.0.0
VersionInfoCompany=john
VersionInfoCopyright=Copyright © John
CreateAppDir=no
OutputDir=.
OutputBaseFilename=Autorun
SetupIconFile=Icon.ico

[Languages]
Name: Russian; MessagesFile: compiler:Default.isl

[Files]
Source: 1.bmp; Flags: dontcopy

[Messages]
SetupAppTitle=AutoRUN

[Code]
const
BM_CLICK = $00F5;

var
AutoRun: TSetupForm;
img1: TBitmapImage;
PlayButton, InstallButton, SupportButton, ReadmeButton, WebButton, ExitButton, UninstallButton: TButton;
AppPath,UninsPath: string;
ResultCode: Integer;
procedure CurPageChanged(CurPageID: Integer);
begin
If CurPageID=wpWelcome then
SendMessage(WizardForm.NextButton.Handle, BM_CLICK, 0, 0);
end;

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
Confirm:=False
Cancel:=True
end;

procedure PlayButtonClick(Sender: TObject);
var
exe: string;
begin
exe:='shift.exe';
if RegQueryStringValue(HKLM, 'SOFTWARE\Electronic Arts\Game','Install Dir', AppPath) then
begin
Exec(AddBackslash(AppPath) + Exe, '', ExtractFilePath(AddBackslash(AppPath) + Exe), SW_SHOWNORMAL,ewNoWait,ResultCode)
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end
end;

procedure InstallButtonClick(Sender: TObject);
var
CurPageID: Integer;
begin
Exec(ExpandConstant('{src}\Setup.exe'),'','',SW_SHOW,ewNoWait,ResultCode)
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end;

procedure SupportButtonClick(Sender: TObject);
begin
shellexec('open', ExpandConstant('{src}\Game.exe'), '', '',SW_SHOWNORMAL, ewnowait, ResultCode)
end;

procedure ReadmeButtonClick(Sender: TObject);
begin
ShellExec('open', ExpandConstant('{src}\readme.txt'),'','', SW_SHOW, ewNoWait, ResultCode)
end;

procedure WebButtonClick(Sender: TObject);
begin
shellexec('open', 'http://localhost', '', '',SW_SHOWNORMAL, ewnowait, ResultCode)
end;

procedure ExitButtonClick(Sender: TObject);
var
CurPageID: Integer;
begin
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end;

procedure UninstallButtonClick(Sender: TObject);
begin
if RegQueryStringValue(HKLM, 'SOFTWARE\Game','UninstallString', UninsPath) then
begin
UninsPath:=RemoveQuotes(UninsPath)
Exec(UninsPath,'','',SW_SHOWNORMAL,ewNoWait,ResultCode)
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end
end;

procedure CreateAutoRun;
begin
//AutoRun
AutoRun := CreateCustomForm;
with AutoRun do begin
Left := 498;
Top := 75;
Width := 495;
Height := 340;
BorderIcons := [];
BorderStyle:=bsToolWindow //(bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin)
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
Position := poScreenCenter;
Caption:='AutoRUN'
end;
//img1
img1 := TBitmapImage.Create(AutoRun);
ExtractTemporaryFile('1.bmp');
with img1 do begin
Parent := AutoRun;
Left := 0;
Stretch:= true;
Top := 0;
Width := Autorun.Width;
Height := Autorun.Height;
Bitmap.LoadFromFile(ExpandConstant('{tmp}\1.bmp'));
end;
//PlayButton
PlayButton:= TButton.Create(AutoRun);
with PlayButton do begin
Parent := AutoRun;
Left := 300;
Top := 110;
Width := 150;
Height := 22;
Caption:= 'Начать игру';
Cursor:= crHand;
// ModalResult:= mrOk;
OnClick := @PlayButtonClick;
if not RegQueryStringValue(HKLM, 'SOFTWARE\Game','Install Dir', AppPath) then
begin
PlayButton.Enabled := False;
end
end;
//InstallButton
InstallButton:= TButton.Create(AutoRun);
with InstallButton do begin
Parent:= AutoRun;
Left := 300;
Top := 80;
Width := 150;
Height := 22;
Caption:= 'Install Game';
Cursor:= crHand;
OnClick := @InstallButtonClick;
end;
//SupportButton
SupportButton:= TButton.Create(AutoRun);
with SupportButton do begin
Parent:= AutoRun;
Left := 300;
Top := 140;
Width := 150;
Height := 22;
Caption:= 'Инфо';
Cursor:= crHand;
OnClick := @SupportButtonClick;
end;
//ReadmeButton
ReadmeButton:= TButton.Create(AutoRun);
with ReadmeButton do begin
Parent:= AutoRun;
Left := 300;
Top := 170;
Width := 150;
Height := 22;
Caption:= 'Readme';
Cursor:= crHand;
OnClick := @ReadmeButtonClick;
end;
//WebButton
WebButton:= TButton.Create(AutoRun);
with WebButton do begin
Parent:= AutoRun;
Left := 300;
Top := 200;
Width := 150;
Height := 22;
Caption:= 'Веб-сайт';
Cursor:= crHand;
OnClick := @WebButtonClick;
end;
//ExitButton
ExitButton:= TButton.Create(AutoRun);
with ExitButton do begin
Parent:= AutoRun;
Left := 300;
Top := 260;
Width := 150;
Height := 22;
Caption:= 'Выход';
Cursor:= crHand;
OnClick := @ExitButtonClick;
// ModalResult:= mrCancel;
end;
//UninstallButton
UninstallButton:= TButton.Create(AutoRun);
with UninstallButton do begin
Parent:= AutoRun;
Left := 300;
Top := 230;
Width := 150;
Height := 22;
Caption:= 'Удалить игру';
Cursor:= crHand;
OnClick := @UninstallButtonClick;
end;

if not RegQueryStringValue(HKLM, 'SOFTWARE\Game','UninstallString', UninsPath) then
begin
InstallButton.Enabled:=true;
UninstallButton.Enabled:=false;
end;
if RegQueryStringValue(HKLM, 'SOFTWARE\Game','UninstallString', UninsPath) then
begin
InstallButton.Enabled:=false;
UninstallButton.Enabled:=true;
end;

AutoRun.ShowModal;
end;

procedure InitializeWizard;
begin
CreateAutoRun;
end;

[/more]
Вот авторан кнопки передвигай сам!
Автор: TonyJef
Дата сообщения: 12.08.2010 13:27
troyan90,а АМВ сойдет?
Автор: ChanVS
Дата сообщения: 12.08.2010 13:28
Кто поможет с этим?
http://rghost.ru/2326118/image.png
1. Не показывет движение
2. Не показывает название файла в работе.
Автор: TonyJef
Дата сообщения: 12.08.2010 13:29
[more]#define MyAppName "Fifa 09: RPL Mod"
#define PB_ImageFile "progress.bmp"
;укажите расположение архивов FreeArc
;для внешних файлов строку в [Files] добавлять необязательно
#define Archives "'{src}\*.arc'"
#define Image_SelectDirPage "papka.bmp"
#define NeedSize "7200"
#define TotalNeedSize "7200"
#define NeedMHz "2200"
#define NeedVideoRAM "256"
#define NeedSoundCard "'Realtek HD'"
#define NeedRAM "1024"
#define NeedPageFile "2048"

[Setup]
AppName=Fifa 09: RPL Mod
AppVerName=Fifa 09: RPL Mod v1.0
DefaultDirName={pf}\TeraGames\Fifa 09
DefaultGroupName=Fifa 09 by TJ109
DirExistsWarning=no
ShowLanguageDialog=auto
OutputBaseFilename=Setup
SetupIconFile=InstallFiles\fifa.ico
VersionInfoCopyright=TJ109
WizardImageFile=InstallFiles\WizardImage.bmp
WizardSmallImageFile=InstallFiles\WizardSmallImage.bmp
InternalCompressLevel=ultra64
Compression=lzma/ultra64
ShowTasksTreeLines=true
AllowNoIcons=true

[CustomMessages]
rus.Welcome1=Вас приветствует %nМастер установки игры
rus.Welcome2=Программа установит игру {#MyAppName} %%nна Ваш компьютер.%nРекомендуется закрыть антивирусные пакеты, %nа также все прочие приложения перед тем, %nкак продолжить.%nНажмите «Далее», чтобы продолжить, или «Отмена», %nчтобы выйти из программы установки.
rus.ArcBreak=Установка прервана!
rus.Finished4=Установка игры {#MyAppName} не завершена.
rus.Extracted=Распаковка игровых архивов...
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=%nОсталось ждать %1
rus.LongTime=вечно
rus.ending=завершение
rus.hour=часов
rus.min=мин
rus.sec=сек
rus.but=Установить
rus.space=Доступно места на диске:
rus.space1=Требуется места на диске:
rus.Finished1=Установка игры {#MyAppName} успешно завершена.
rus.Finished2=Игра {#MyAppName} была успешно установлена на Ваш компьютер. %n%nДля ее запуска выберите соответствующий ярлык в меню «Пуск» или на Рабочем столе.
rus.Finished3=Нажмите «Завершить», чтобы выйти из программы установки.
rus.DirectXInstall=Идет обновление DirectX... Пожалуйста, подождите.
rus.DirectX=Обновить DirectX
rus.VisualCInstall=Идет установка VisualC++ Redist... Пожалуйста, подождите.
rus.VisualC=Установить VisualC++ Redist
rus.DeleteSave=Удалить сохраненные игры и профили?

[Tasks]
Name: desktopicon; Description: Добавить ярлык на рабочий стол
Name: Redist; Description: Дополнительное программное обеспечение:
Name: Redist\directx; Description: Обновить Microsoft DirectX
Name: Redist\visualc; Description: Установить Microsoft Visual C++ Redist

[Files]
Source: InstallFiles\*; Flags: dontcopy
Source: InstallFiles\fifa.ico; DestDir: {app}; Flags: ignoreversion; Attribs: hidden system
Source: InstallFiles\fifa.ico; DestDir: {app}; Flags: ignoreversion; Attribs: hidden system
Source: InstallFiles\ISSkin.dll; DestDir: {app}; Flags: ignoreversion; Attribs: hidden system
Source: C:\Users\GameSofterTJ\Downloads\Styles\Styles\Style\Style\Aero UI (Day).cjstyles; DestDir: {app}; Flags: ignoreversion; Attribs: hidden system
Source: InstallFiles\InnoCallback.dll; DestDir: {app}; Flags: ignoreversion; Attribs: hidden system
Source: ..\..\Games\Fifa 09\FIFA09.exe; DestDir: {app}\Fifa 09\; Flags: ignoreversion

[Run]
Filename: {src}\Redist\DirectX\DXSETUP.exe; WorkingDir: {src}\Redist\DirectX\; Parameters: /silent; StatusMsg: {cm:DirectX}; Tasks: Redist\directx; Flags: waituntilterminated; BeforeInstall: ProgressExt()
Filename: {src}\Redist\VisualC++\vcredist_x86.exe; WorkingDir: {src}\Redist\VisualC++\; Parameters: /q; StatusMsg: {cm:VisualC}; Tasks: Redist\visualc; Flags: waituntilterminated; Check: not IsWin64; BeforeInstall: ProgressExt1()
Filename: {src}\Redist\VisualC++\vcredist_x64.exe; WorkingDir: {src}\Redist\VisualC++\; Parameters: /q; StatusMsg: {cm:VisualC}; Tasks: Redist\visualc; Flags: waituntilterminated; Check: IsWin64; BeforeInstall: ProgressExt1()

[Icons]
Name: {userdesktop}\Fifa 09; Filename: {app}\Fifa 09\FIFA09.exe; IconFilename: {app}\fifa.ico; WorkingDir: {app}\Fifa 09; Tasks: desktopicon
Name: {group}\Fifa 09; Filename: {app}\Fifa 09\FIFA09.exe; IconFilename: {app}\fifa.ico; WorkingDir: {app}\Fifa 09; Comment: Запустить игру
Name: {group}\{cm:UninstallProgram,Fifa 09}; Filename: {app}\unins000.exe; WorkingDir: {app}; IconFilename: {app}\fifa.ico; Comment: Удалить игру

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

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

[Code]
const
Color = $000000; // Общий цвет инсталлятора $000000 - черный
Archives = {#Archives};
PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMb = 1048576;
BtnClickEventID = 1;
BtnMouseEnterEventID = 2;
BASS_ACTIVE_PAUSED = 3;
BASS_SAMPLE_LOOP = 4;

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

TBtnEventProc = procedure (h:HWND);
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path: string; OrigSize: Integer; Size: Extended; end;
TProc = procedure(HandleW, msg, idEvent, TimeSys: LongWord);
TMyMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;

var

ExtractFile, FileNamelbl, lblExtractFileName, WelcomeLabel1, WelcomeLabel2,FinishedLabel, StatusLabel,
FinishedHeadingLabel, FileNameLabel, LogoLabel, PageDescriptionLabel,PageNameLabel, lbl1, lbl2: TLabel;
Texture2, Texture, LogoImage, papka, Image2, BmpFile, ProgressBar_BitmapImage: TBitmapImage;
CancelCode, n, UnPackError, StartInstall, i, lastMb, baseMb, totalUncompressedSize,
intOldCurrWidth, ProgressBar_ImageHeight, ResultCode, ErrorCode: integer;
msgError, txt1, txt2, mp3Name, AppDir, unins: string;
btnCancelUnpacking: TButton;
MusicButton,mp3Handle: HWND;
FreeMB, TotalMB: Cardinal;
ProgressBar_Edit : TEdit;
LastTimerEvent: DWORD;
Arcs: array of TArc;
TimerID: LongWord;
LogoPanel: TPanel;
tmr1: TTimer;

function WrapBtnCallback(Callback: TBtnEventProc; ParamCount: Integer): Longword; external 'wrapcallback@{tmp}\innocallback.dll stdcall delayload';
function BtnCreate(hParent:HWND; Left,Top,Width,Height:integer; FileName:PAnsiChar; ShadowWidth:integer; IsCheckBtn:boolean):HWND; external 'BtnCreate@{tmp}\botva2.dll stdcall delayload';
function BtnGetChecked(h:HWND):boolean; external 'BtnGetChecked@{tmp}\botva2.dll stdcall delayload';
procedure BtnSetEvent(h:HWND; EventID:integer; Event:Longword); external 'BtnSetEvent@{tmp}\botva2.dll stdcall delayload';
procedure BtnSetVisibility(h:HWND; Value:boolean); external 'BtnSetVisibility@{tmp}\botva2.dll stdcall delayload';
procedure BtnSetCursor(h:HWND; hCur:Cardinal); external 'BtnSetCursor@{tmp}\botva2.dll stdcall delayload';
function GetSysCursorHandle(id:integer):Cardinal; external 'GetSysCursorHandle@{tmp}\botva2.dll stdcall delayload';
function sndPlaySound(lpszSoundName: AnsiString; uFlags: cardinal):integer; external 'sndPlaySoundA@winmm.dll stdcall';

function WrapTimerProc(callback:TProc; paramcount:integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd: LongWord; nIDEvent, uElapse: LongWord; lpTimerFunc: LongWord): LongWord; external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd: LongWord; nIDEvent: LongWord): LongWord; external 'KillTimer@user32.dll stdcall';

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

procedure InitializeWizard1();
Begin
ExtractTemporaryFile('Image2.bmp');

BmpFile:= TBitmapImage.Create(WizardForm);
BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image2.bmp'));
BmpFile.Top:= ScaleY(0);
BmpFile.Left:= ScaleX(0);
BmpFile.Width:= ScaleX(497);
BmpFile.Height:= ScaleY(313);
BmpFile.Stretch:= true
BmpFile.Parent:= WizardForm.FinishedPage;
end;

procedure ProgressExt();
begin
WizardForm.FileNamelabel.Caption:= ExpandConstant('{cm:DirectXInstall}')
end;

procedure ProgressExt1();
begin
WizardForm.FileNamelabel.Caption:= ExpandConstant('{cm:VisualCInstall}')
end;

////////////////////// WelcomePage //////////////////////

procedure tmr1Timer(Sender: TObject);
begin
tmr1.Enabled:= False;

txt1:= WizardForm.WelcomeLabel1.Caption;
txt2:= WizardForm.WelcomeLabel2.Caption;

lbl1.Caption:= '';
for i:= 1 to Length(txt1) do begin
if Application.Terminated then Break; // контроль закрытия приложения и выход из цикла
lbl1.Caption:= lbl1.Caption + txt1[i];
Application.ProcessMessages;
Sleep(100); // время задержки между показом букв
end;

lbl2.Caption:= '';
for i:= 1 to Length(txt2) do begin
if Application.Terminated then Break; // контроль закрытия приложения и выход из цикла
lbl2.Caption:= lbl2.Caption + txt2[i];
Application.ProcessMessages;
Sleep(60); // время задержки между показом букв
end;
end;

procedure CreateComponents;
begin
// задаём свои Label'ы
lbl1:= TLabel.Create(WizardForm);
with lbl1 do
begin
Left:= 75;
Top:= ScaleY(70);
Width:= ScaleX(350);
Height:= ScaleY(65);
AutoSize:= false;
Alignment := taCenter;
Transparent:= true;
WordWrap:= true;
Font.Name:='Georgia';
Font.Size:= 13;
Font.Color:=$ffffff;
Font.Style := [fsBold];
Parent:= WizardForm.WelcomePage;
Caption:= '';
end;

lbl2:=TLabel.Create(WizardForm);
with lbl2 do
begin
Top:= ScaleY(120);
Left:= 25;
Width:= ScaleX(450);
Height:= ScaleY(200);
AutoSize:= false;
Alignment := taCenter;
WordWrap:= true;
Font.Name:= 'Georgia';
Font.Size:= 10
Font.Style := [fsBold, fsItalic];
Font.Color:=ClWhite;
Transparent:= true;
Parent:= WizardForm.WelcomePage;
Caption:= '';
end;

tmr1:= TTimer.Create(WizardForm);
with tmr1 do begin
Interval:= 500; // время задержки перед началом показа текста
OnTimer:= @tmr1Timer;
end;

////////////////////// WelcomePage //////////////////////

////////////////////// FinishedPage //////////////////////

FinishedHeadingLabel:= TLabel.Create(WizardForm);
with FinishedHeadingLabel do begin
Left:= 75;
Top:= ScaleY(60);
Width:= ScaleX(350);
Height:= ScaleY(65);
AutoSize:= false;
Alignment := taCenter;
Transparent:= true;
WordWrap:= true;
Font.Name:='Georgia';
Font.Size:= 13;
Font.Color:=$ffffff;
Font.Style := [fsBold];
Caption:= ExpandConstant('{cm:Finished1}');
Parent:=WizardForm.FinishedPage;
end;

FinishedLabel:=TLabel.Create(WizardForm);
with FinishedLabel do begin
AutoSize:=False
SetBounds(ScaleX(75), ScaleY(125), ScaleX(348), ScaleY(200));
WordWrap:=True
Transparent:=True
Font.Name:='Georgia';
Font.Size:= 10;
Font.Color:=$FFFFFF;
Font.Style := [fsBold, fsItalic];
Caption:= ExpandConstant('{cm:Finished2}')+#13#13+ExpandConstant('{cm:Finished3}');
Parent:=WizardForm.FinishedPage;
end;
end;

////////////////////// FinishedPage //////////////////////

//******************************************* [Начало - FreeArc] *************************************************//

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;

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

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

// Преобразует строку из 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;

// Конвертирует милисекунды в человеко-читаемое изображение времени
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
// Этот код будет выполняться раз в 1000 миллисекунд
// End of code executed by timer
LastTimerEvent := LastTimerEvent+1000;
end;

if string(what)='filename' then begin
// Update FileName label
lblExtractFileName.Caption:= FmtMessage(ExpandConstant('{app}\')+(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;
FileNameLbl.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;
FileNamelbl.Caption:= '';
FileNamelbl.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
FileNamelbl.Hide;
lblExtractFileName.Hide;
ExtractFile.Hide;
btnCancelUnpacking.Hide;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
WizardForm.FileNameLabel.Visible:= False
WizardForm.StatusLabel.Caption:= ExpandConstant('{cm:Extracted}')
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 CurPageChanged1(CurPageID: Integer);
Begin
if (CurPageID = wpFinished) and (UnPackError <> 0) then
begin // Extraction was unsuccessful (распаковщик вернул ошибку)
// Show error message
FinishedHeadingLabel.Caption:= ExpandConstant('{cm:Finished4}');
FinishedHeadingLabel.Font.Color:= $0000C0; // red (красный)
FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#13 + ExpandConstant('{cm:Finished3}');
FinishedLabel.Font.Color:= $0000C0; // red (красный)
end;
End;

procedure InitializeWizard2();
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.Left:= ScaleX(0);
lblExtractFileName.Top:= ScaleY(15);
lblExtractFileName.Width:= ScaleX(625);
lblExtractFileName.Height:= ScaleY(20);
lblExtractFileName.Caption:= '';
lblExtractFileName.Transparent := True;
lblExtractFileName.Font.Name:= 'Georgia'
lblExtractFileName.Font.Size:= 8;
lblExtractFileName.Font.Style:= [fsItalic];
lblExtractFileName.Font.Color:= clWhite;
lblExtractFileName.Hide;

// Create a label to show percentage
ExtractFile:= TLabel.Create(WizardForm);
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Left:= ScaleX(-105);
ExtractFile.Top:= ScaleY(80);
ExtractFile.Width:= ScaleX(625);
ExtractFile.Height:= ScaleY(20);
ExtractFile.Alignment := taCenter;
ExtractFile.caption:= '';
ExtractFile.Transparent := True;
ExtractFile.Font.Name:= 'Georgia'
ExtractFile.Font.Size:= 8;
ExtractFile.Font.Style:= [fsItalic];
ExtractFile.Font.Color:= clWhite;
ExtractFile.Hide;

FileNamelbl:= TLabel.Create(WizardForm);
FileNamelbl.parent:=WizardForm.InstallingPage;
FileNamelbl.autosize:=false;
FileNamelbl.Left:= ScaleX(-105);
FileNamelbl.Top:= ScaleY(94);
FileNamelbl.Width:= ScaleX(625);
FileNamelbl.Height:= ScaleY(50);
FileNamelbl.Alignment := taCenter;
FileNamelbl.caption:= '';
FileNamelbl.Transparent := True;
FileNamelbl.Font.Name:= 'Georgia'
FileNamelbl.Font.Size:= 8;
FileNamelbl.Font.Style:= [fsItalic];
FileNamelbl.Font.Color:= clWhite;
FileNamelbl.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;

//******************************************* [Конец - FreeArc] *************************************************//

//******************************************* [Начало - Тема] ***************************************************//

procedure LoadSkin(lpszPath: string; lpszIniFileName: string ); external 'LoadSkin@files:isskin.dll stdcall delayload setuponly';
procedure LoadSkinUninst(lpszPath: string; lpszIniFileName: string ); external 'LoadSkin@{tmp}\isskin.dll stdcall delayload uninstallonly';
procedure UnloadSkin(); external 'UnloadSkin@files:isskin.dll stdcall delayload setuponly';
procedure UnloadSkinUninst(); external 'UnloadSkin@{tmp}\isskin.dll stdcall delayload uninstallonly';
function ShowWindow(hWnd: Integer; uType: Integer): Integer; external 'ShowWindow@user32.dll stdcall';

//******************************************* [Конец - Тема] ***************************************************//

//******************************************* [ начало изображения 497 360 ] ***************************************************//

procedure InitializeWizard3();
var
Page: TWizardPage;
begin
WizardForm.WizardBitmapImage.Width:=497
WizardForm.WelcomeLabel1.Visible:=False
WizardForm.WelcomeLabel2.Visible:=False
WizardForm.WizardBitmapImage2.Visible:=False
WizardForm.FinishedLabel.Visible:=False
WizardForm.FinishedHeadingLabel.Visible:=False

//******************************************* [ конец 497 360 изображения ] ***************************************************//

//******************************************* [ начало 497 58 изображения ] ***************************************************//

PageNameLabel:= TLabel.Create(WizardForm);
with PageNameLabel do
begin
Left:= ScaleX(110);
Top:= ScaleY(10);
Width:= ScaleX(370);
Height:= ScaleY(14);
AutoSize:= False;
WordWrap:= True;
Font.Name:= 'Georgia';
Font.Color:= $ffffff;
Font.Style:= [fsBold];
ShowAccelChar:= False;
Transparent:= True;
Parent:= WizardForm.MainPanel;
end;

PageDescriptionLabel:= TLabel.Create(WizardForm);
with PageDescriptionLabel do
begin
Left:= ScaleX(130);
Top:= ScaleY(25);
Width:= ScaleX(330);
Height:= ScaleY(30);
AutoSize:= False;
WordWrap:= True;
Font.Name:= 'Georgia';
Font.Color:= $ffffff;
Font.Style:= [fsItalic];
ShowAccelChar:= False;
Transparent:= True;
Parent:= WizardForm.MainPanel;
end;

with WizardForm do
begin
PageNameLabel.Hide;
PageDescriptionLabel.Hide;
with MainPanel do
begin
with WizardSmallBitmapImage do
begin
Left:= ScaleX(0);
Top:= ScaleY(0);
Width:= Mainpanel.Width;
Height:= MainPanel.Height;
end;
end;
end;

//******************************************* [конец 497 58 изображения ] ***************************************************//

//******************************************* [Начало - инсталл] ***************************************************//

// Папка
papka := TBitmapImage.Create(WizardForm);
with papka do
begin
Parent:= WizardForm.SelectDirPage;
Left := ScaleX(0);
Top := ScaleY(0);
AutoSize:=True;
ExtractTemporaryFile('papka.bmp');
Bitmap.LoadFromFile(ExpandConstant('{tmp}\{#Image_SelectDirPage}'));
end;

WizardForm.Font.Color:=clWhite;
WizardForm.Font.Name:='Georgia';
WizardForm.Font.Style:=[fsItalic];
WizardForm.Color:=Color;
WizardForm.WelcomePage.Color:=Color;
WizardForm.InnerPage.Color:=Color;
WizardForm.FinishedPage.Color:=Color;
WizardForm.LicensePage.Color:=Color;
WizardForm.PasswordPage.Color:=Color;
WizardForm.InfoBeforePage.Color:=Color;
WizardForm.UserInfoPage.Color:=Color;
WizardForm.SelectDirPage.Color:=Color;
WizardForm.SelectComponentsPage.Color:=Color;
WizardForm.SelectProgramGroupPage.Color:=Color;
WizardForm.SelectTasksPage.Color:=Color;
WizardForm.ReadyPage.Color:=Color;
WizardForm.PreparingPage.Color:=Color;
WizardForm.InstallingPage.Color:=Color;
WizardForm.InfoAfterPage.Color:=Color;
WizardForm.DirEdit.Color:=$100800;
WizardForm.DiskSpaceLabel.Color:=Color;
WizardForm.GroupEdit.Color:=$100800;
WizardForm.PasswordLabel.Color:=Color;
WizardForm.PasswordEdit.Color:=Color;
WizardForm.PasswordEditLabel.Color:=Color;
WizardForm.ReadyMemo.Color:=Color;
WizardForm.TypesCombo.Color:=Color;
WizardForm.WelcomeLabel1.Color:=Color;
WizardForm.WelcomeLabel1.Font.Color:=Color;
WizardForm.InfoBeforeClickLabel.Color:=Color;
WizardForm.MainPanel.Color:=Color;
WizardForm.PageNameLabel.Color:=Color;
WizardForm.PageDescriptionLabel.Color:=Color;
WizardForm.ReadyLabel.Color:=Color;
WizardForm.FinishedLabel.Color:=Color;
WizardForm.YesRadio.Color:=Color;
WizardForm.NoRadio.Color:=Color;
WizardForm.WelcomeLabel2.Color:=Color;
WizardForm.LicenseLabel1.Color:=Color;
WizardForm.InfoAfterClickLabel.Color:=Color;
WizardForm.ComponentsList.Color:=Color;
WizardForm.ComponentsDiskSpaceLabel.Color:=Color;
WizardForm.BeveledLabel.Color:=Color;
WizardForm.StatusLabel.Color:=Color;
WizardForm.FilenameLabel.Color:=Color;
WizardForm.SelectDirLabel.Color:=Color;
WizardForm.SelectStartMenuFolderLabel.Color:=Color;
WizardForm.SelectComponentsLabel.Color:=Color;
WizardForm.SelectTasksLabel.Color:=Color;
WizardForm.LicenseAcceptedRadio.Color:=Color;
WizardForm.LicenseNotAcceptedRadio.Color:=Color;
WizardForm.UserInfoNameLabel.Color:=Color;
WizardForm.UserInfoNameEdit.Color:=Color;
WizardForm.UserInfoOrgLabel.Color:=Color;
WizardForm.UserInfoOrgEdit.Color:=Color;
WizardForm.PreparingLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Font.Color:=clWhite;
WizardForm.UserInfoSerialLabel.Color:=Color;
WizardForm.UserInfoSerialEdit.Color:=Color;
WizardForm.TasksList.Color:=Color;
WizardForm.RunList.Color:=Color;
WizardForm.SelectDirBrowseLabel.Color:=Color;
WizardForm.SelectStartMenuFolderBrowseLabel.Color:=Color;
WizardForm.PageNameLabel.Font.Color:=clWhite;
//Избавиться от разделительных полос сверху и снизу
WizardForm.Bevel.visible:=true; // Если не надо, то закомментировать
WizardForm.BeveledLabel.visible:=true; // Если не надо, то закомментировать
WizardForm.Bevel1.visible:=true; // Если не надо, то закомментировать
//Избавляемся от полосы прокрутки в меню Всё готово к установке
//WizardForm.ReadyMemo.ScrollBars:= ssNone
end;

//******************************************* [Конец - инсталл] ***************************************************//

//******************************************* [Место для установки ] ***************************************************//

var
NeedSize, TotalNeedSize:Integer; TotalNeedSpaceLabel,NeedSpaceLabel,FreeSpaceLabel: TLabel;

Function MbOrTb(Byte: Extended): String;
begin
if Byte < 1024 then Result:= NumToStr(Byte) + ' Мб' else
if Byte/1024 < 1024 then Result:= NumToStr(round(Byte/1024*100)/100) + ' Гб' else
Result:= NumToStr(round((Byte/(1024*1024))*100)/100) + ' Тб'
end;

procedure GetFreeSpaceCaption(Sender: TObject);
var
Path: String;
begin
Path := ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
NeedSpaceLabel.Caption := 'Игра займет на диске: '+ MbOrTb(NeedSize)
TotalNeedSpaceLabel.Caption := 'Для распаковки требуется: '+ MbOrTb(TotalNeedSize)
FreeSpaceLabel.Caption := 'Доступно места на диске: '+ MbOrTb(FreeMB)
WizardForm.NextButton.Enabled:= (FreeMB>TotalNeedSize);
if (FreeMB<TotalNeedSize) then
TotalNeedSpaceLabel.Font.Color:=clRed else
TotalNeedSpaceLabel.Font.Color:=clWhite
if (FreeMB<NeedSize) then
NeedSpaceLabel.Font.Color:=clRed else
NeedSpaceLabel.Font.Color:=clWhite
end;

procedure InitializeWizard4();
begin
NeedSize := {#NeedSize};
TotalNeedSize := {#TotalNeedSize};

WizardForm.DiskSpaceLabel.Hide;

TotalNeedSpaceLabel := TLabel.Create(WizardForm);
TotalNeedSpaceLabel.Parent := WizardForm.SelectDirPage;
TotalNeedSpaceLabel.SetBounds(ScaleX(5), ScaleY(200), ScaleX(209), ScaleY(13))

FreeSpaceLabel := TLabel.Create(WizardForm);
FreeSpaceLabel.Parent := WizardForm.SelectDirPage;
FreeSpaceLabel.SetBounds(ScaleX(5), ScaleY(180), ScaleX(209), ScaleY(13))

NeedSpaceLabel := TLabel.Create(WizardForm);
NeedSpaceLabel.Parent := WizardForm.SelectDirPage;
NeedSpaceLabel.SetBounds(ScaleX(5), ScaleY(220), ScaleX(209), ScaleY(13))

WizardForm.DirEdit.OnChange := @GetFreeSpaceCaption;
end;

//******************************************* [ конец Место для установки ] ***************************************************//

//******************************************* [Начало - Проверка сист. требований] ***************************************************//

type
PDisplay_Device = record
cb: DWord;
DeviceName: array [0..31] of char;
DeviceString: array [0..127] of char;
StateFlags: DWord;
DeviceID, DeviceKey: array [0..127] of char;
end;

TMixerCaps = record
vPid, vDriverVersion: DWord;
sName: array [0..31] of char;
Support, cDestinations: DWord;
end;

// Проверка версии Windows
#if Pos("4.", GetFileVersion(AddBackslash(GetEnv("windir")) + "Explorer.exe")) == 1
{Win9x}
TMemoryStatusEx = record
dwLength, dwMemoryLoad: DWord;
LoTotalPhys, LoAvailPhys, LoTotalPageFile, LoAvailPageFile,
LoTotalVirtual, LoAvailVirtual, LoAvailExtendedVirtual, HiTotalPhys,
HiAvailPhys, HiTotalPageFile, HiAvailPageFile, HiTotalVirtual, HiAvailVirtual,
HiAvailExtendedVirtual: Integer;
end;
function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): Boolean;
external 'GlobalMemoryStatus@kernel32.dll stdcall';
#else
{WinNT}
TMemoryStatusEx = record
dwLength, dwMemoryLoad: DWord;
LoTotalPhys, HiTotalPhys, LoAvailPhys, HiAvailPhys,
LoTotalPageFile, HiTotalPageFile, LoAvailPageFile, HiAvailPageFile,
LoTotalVirtual, HiTotalVirtual, LoAvailVirtual, HiAvailVirtual, LoAvailExtendedVirtual,
HiAvailExtendedVirtual: Integer;
end;
function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): Boolean;
external 'GlobalMemoryStatusEx@kernel32.dll stdcall';
#endif

const
DISPLAY_DEVICE_PRIMARY_DEVICE = 4;
NeedMHz = {#NeedMHz};
NeedVideoRAM = {#NeedVideoRAM};
NeedSoundCard = {#NeedSoundCard};
NeedMB = {#NeedRAM};
NeedPageFile = {#NeedPageFile};

var
InfoPage: TWizardPage;
TopText, BottomText: TNewStaticText;
ChangeText: Boolean;
SystemPanel, ProcessorPanel, VideoPanel,
AudioPanel, RAMPanel, PageFilePanel: TMemo;
SystemVersionPanel, ProcessorMHzPanel, VideoRAMPanel,
AudioNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;
lpCaps: TMixerCaps;
Version: TWindowsVersion;
MemoryEx: TMemoryStatusEx;
errCode: Integer;
Keys: TArrayOfString;
DeviceValue: Cardinal;
lpDisplayDevice: PDisplay_Device;

function GetSystemMetrics(nIndex: Integer): Integer;
external 'GetSystemMetrics@user32.dll stdcall';

function GetDeviceCaps(hDC, nIndex: Integer): Integer;
external 'GetDeviceCaps@GDI32 stdcall';

function CreateDC(lpDriverName, lpDeviceName, lpOutput: String; lpInitData: Integer): Integer;
external 'CreateDCA@GDI32 stdcall';

function EnumDisplayDevices(lpDevice, iDevNum: DWord; var lpDisplayDevice: PDisplay_Device; dwFlags: DWord): Boolean;
external 'EnumDisplayDevicesA@user32.dll stdcall';

function mixerGetDevCaps(uDeviceID: LongInt; var lpCaps: TMixerCaps; uSize: LongInt): LongInt;
external 'mixerGetDevCapsA@winmm.dll stdcall';

function mixerGetNumDevs: Integer;
external 'mixerGetNumDevs@winmm.dll stdcall';

// Дополнить число до кратного Multiple
function ToMultiple(Bytes, Multiple: Integer): Integer;
begin
if Abs(Bytes/Multiple) > Bytes/Multiple then
Result := (Bytes/Multiple + 1)*Multiple
else
Result := Bytes
end;

// Перевод числа в значение Бт/Кб/Мб/Гб/Тб (до 3х знаков после запятой)
function ByteOrTB(Bytes: Extended; noMB: Boolean): String;
begin
if not noMB then
Result := FloatToStr(Int(Bytes)) + ' Мб'
else
if Bytes < 1024 then
Result := FloatToStr(Int(Bytes)) + ' Бт'
else
if Bytes/1024 < 1024 then
Result := FloatToStr(round((Bytes/1024)*10)/10) + ' Кб'
else
if Bytes/oneMB < 1024 then
Result := FloatToStr(round(Bytes/oneMB*100)/100) + ' Мб'
else
if Bytes/oneMB/1000 < 1024 then
Result := FloatToStr(round(Bytes/oneMB/1024*1000)/1000) + ' Гб'
else
Result := FloatToStr(round(Bytes/oneMB/oneMB*1000)/1000) + ' Тб'
StringChange(Result, ',', '.')
end;

// Удаление начальных, конечных и повторных пробелов
function DelSp(String: String): String;
begin
while (Pos(' ', String) > 0) do Delete(String, Pos(' ', String), 1)
Result := Trim(String)
end;

function CheckCPU(NeedMHz: Integer): Boolean;
var
String: String;
begin
String := 'Hardware\Description\System\CentralProcessor'; RegGetSubkeyNames(HKLM, String, Keys) // Количество ядер
for n := 0 to GetArrayLength(Keys)-1 do
RegQueryStringValue(HKLM, String + '\' + Keys[n], 'ProcessorNameString', Keys[n])
if not RegQueryDWordValue(HKLM, String + '\0', '~MHz', DeviceValue) or (DeviceValue < NeedMHz) then
Exit
else
Result := True
end;

function CheckMemorySize(NeedRAM: Integer): Boolean;
begin
MemoryEx.dwLength := SizeOf(MemoryEx)
if not GlobalMemoryStatusEx(MemoryEx) then
MsgBox('Ошибка функции:' + #13 + 'GlobalMemoryStatusEx', mbError, mb_Ok)

else
if (ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16) < NeedRAM) then
Exit
else
Result := True
end;

procedure CreateCheckForm();
begin

TopText := TNewStaticText.Create(InfoPage)
with TopText do
begin
Parent := InfoPage.Surface
Left := 0
AutoSize := True
end

BottomText := TNewStaticText.Create(InfoPage)
with BottomText do
begin
Parent := InfoPage.Surface
Caption := 'Когда Вы будете готовы продолжить установку, нажмите «Далее»'
Font.Color := clWhite
Font.Name :='Georgia';
Font.Style:=[fsItalic];
Left := 0
Top := 200
AutoSize := True
end

SystemPanel := TMemo.Create(InfoPage)
with SystemPanel do
begin
Text := 'Система'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := ScaleY(33)
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := clBlack
end

SystemVersionPanel := TMemo.Create(InfoPage)
with SystemVersionPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := SystemPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

ProcessorPanel := TMemo.Create(InfoPage)
with ProcessorPanel do
begin
Text := 'Процессор'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := SystemPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := clBlack
end

ProcessorMHzPanel := TMemo.Create(InfoPage)
with ProcessorMHzPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := ProcessorPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

VideoPanel := TMemo.Create(InfoPage)
with VideoPanel do
begin
Text := 'Видеоадаптер'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := ProcessorPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := clBlack
end

VideoRAMPanel := TMemo.Create(InfoPage)
with VideoRAMPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := VideoPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

AudioPanel := TMemo.Create(InfoPage)
with AudioPanel do
begin
Text := 'Звук'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := VideoPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := clBlack
end

AudioNamePanel := TMemo.Create(InfoPage)
with AudioNamePanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := AudioPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

RAMPanel := TMemo.Create(InfoPage)
with RAMPanel do
begin
Text := 'Память'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := AudioPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := clBlack
end

RAMTotalPanel := TMemo.Create(InfoPage)
with RAMTotalPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := RAMPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

PageFilePanel := TMemo.Create(InfoPage)
with PageFilePanel do
begin
Text := 'Подкачка'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := RAMPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := clBlack
end;

PageFileTotalPanel := TMemo.Create(InfoPage)
with PageFileTotalPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := PageFilePanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

end;

procedure UpdateInfo();
var
DeviceName, DeviceKey: String;
begin
ChangeText := False

GetWindowsVersionEx(Version)

// Операционная система:
SystemVersionPanel.Color := clBlack
SystemVersionPanel.Font.Color := clLime

DeviceKey := 'Software\Microsoft\Windows NT\CurrentVersion'
if not UsingWinNT then StringChange(DeviceKey, 'Windows NT', 'Windows')
RegQueryStringValue(HKLM, DeviceKey, 'ProductName', DeviceName)
if RegQueryStringValue(HKLM, DeviceKey, 'CSDVersion', DeviceKey) then
DeviceName := DeviceName + ' ' + DeviceKey
StringChange(DeviceName, 'Microsoft ', '')
SystemVersionPanel.Text := ' ' + DeviceName + ' сборка ' + IntToStr(Version.Major) + '.' + IntToStr(Version.Minor) +
'.' + IntToStr(Version.Build)

if (Pos('2000 Service Pack 4', SystemVersionPanel.Text) = 0) and // Windows 2000 SP4
(Pos('XP Service Pack 2', SystemVersionPanel.Text) = 0) and // Windows XP SP2
(Pos('XP Service Pack 3', SystemVersionPanel.Text) = 0) and // Windows XP SP3
(Pos('Vista', SystemVersionPanel.Text) = 0) and // Windows Vista (c любым SP или без него)
(Pos('Windows 7', SystemVersionPanel.Text) = 0) then // Windows 7 (c любым SP или без него)
begin
SystemVersionPanel.Color := clBlack
SystemVersionPanel.Font.Color := clRed
ChangeText := True
end

// Процессор:
ProcessorMHzPanel.Color := clBlack
ProcessorMHzPanel.Font.Color := clLime

if not CheckCPU(NeedMHz) then
begin
ProcessorMHzPanel.Color := clBlack
ProcessorMHzPanel.Font.Color := clRed
ChangeText := True
end

ProcessorMHzPanel.Text := ' ' + DelSp(Keys[0]) + ' @' + IntToStr(DeviceValue) + ' MHz'
if GetArrayLength(Keys) > 1 then
ProcessorPanel.Text := 'Процессоры' // + ' (' + IntToStr(GetArrayLength(Keys)) + ')'

// Видеокарта:
VideoRAMPanel.Color := clBlack
VideoRAMPanel.Font.Color := clLime

lpDisplayDevice.cb := SizeOf(lpDisplayDevice)
DeviceKey := ''
n := 0
while not (EnumDisplayDevices(0, n, lpDisplayDevice, 0) and
(lpDisplayDevice.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE > 0)) and (n < 127) do n := n + 1
for n := 0 to 127 do DeviceKey := DeviceKey + lpDisplayDevice.DeviceKey[n]
Delete(DeviceKey, Pos(Chr(0), DeviceKey), 127) // Ключ драйвера получаем из API
StringChange(DeviceKey, '\Registry\Machine\', '')
errCode := 1
DeviceValue := 0
if RegQueryBinaryValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceName) then
for n := 1 to Length(DeviceName) do
begin
DeviceValue := DeviceValue + Ord(DeviceName[n])*errCode
errCode := errCode*$100
end
else
if RegQueryDWordValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceValue) then
else
RegQueryDWordValue(HKLM, DeviceKey + '\Info', 'VideoMemory', DeviceValue)
DeviceName := ''
for n := 0 to 127 do DeviceName := DeviceName + lpDisplayDevice.DeviceString[n]
Delete(DeviceName, Pos(Chr(0), DeviceName), 127)

if DeviceName <> '' then
if DeviceValue > 0 then
VideoRAMPanel.Text := ' ' + DelSp(DeviceName) + ', '+ ByteOrTB(DeviceValue/oneMB, False)
else
VideoRAMPanel.Text := ' ' + DelSp(DeviceName) + ' (Standard), '+ ByteOrTB(DeviceValue/oneMB, False)
else
begin
VideoRAMPanel.Text := ' Драйвер устройства не обнаружен'
VideoRAMPanel.Color := clBlack
VideoRAMPanel.Font.Color := clRed
ChangeText := True
end
if (DeviceValue/oneMB < NeedVideoRAM) then
begin
VideoRAMPanel.Color := clBlack
VideoRAMPanel.Font.Color := clRed
ChangeText := True
end
VideoRAMPanel.Text := VideoRAMPanel.Text + ', ' + IntToStr(GetSystemMetrics(0)) + 'x' +
IntToStr(GetSystemMetrics(1)) + ' (' + IntToStr(GetDeviceCaps(CreateDC('DISPLAY','','',0),14) *
GetDeviceCaps(CreateDC('DISPLAY','','',0),12)) + ' bit)'

// Звуковая карта:
AudioNamePanel.Color := clBlack
AudioNamePanel.Font.Color := clLime

//for errCode := 0 to 1 do // Вывод основного звукового устройства
for errCode := 0 to mixerGetNumDevs do
begin
mixerGetDevCaps(errCode-1, lpCaps, SizeOf(lpCaps))
DeviceName := ' '
for n := 0 to 31 do DeviceName := DeviceName + lpCaps.sName[n]
Delete(DeviceName, Pos(Chr(0), DeviceName), 31)
Delete(DeviceName, Pos(' [', DeviceName), 31)
StringChange(DeviceName, 'SB ', 'Creative ')
Delete(DeviceName, Pos(' Audio', DeviceName), 31)
SetArrayLength(Keys, errCode)
if errCode > 0 then Keys[errCode-1] := DeviceName
end

if GetArrayLength(Keys) > 1 then
begin
AudioPanel.Text := 'Звук'
// AudioPanel.Text := 'Звуковые карты (' + IntToStr(GetArrayLength(Keys)) +')'
AudioNamePanel.Text := ''
for n := 1 to GetArrayLength(Keys) do
AudioNamePanel.Text := AudioNamePanel.Text + Keys[n-1] // + '(' + IntToStr(n) + ')'
end
else
if GetArrayLength(Keys) = 0 then
begin
AudioNamePanel.Text := ' Драйвер устройства не обнаружен'
AudioNamePanel.Color := clBlack
AudioNamePanel.Font.Color := clRed
ChangeText := True
end
else
AudioNamePanel.Text := Keys[0]
if Pos(NeedSoundCard, AudioNamePanel.Text) = 0 then
AudioNamePanel.Text := AudioNamePanel.Text + ' (рекомендуется ' + NeedSoundCard + ')'

// Объём памяти:
RAMTotalPanel.Color := clBlack
RAMTotalPanel.Font.Color := clLime
if not CheckMemorySize(NeedMB) then
begin
RAMTotalPanel.Color := clBlack
RAMTotalPanel.Font.Color := clRed
ChangeText := True
end
RAMTotalPanel.Text := ' ' + ByteOrTB(ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16), False) + ' всего, ' +
ByteOrTB(ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16) -
Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys)/oneMB, False) + ' используется, ' +
ByteOrTB(Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys)/oneMB, False) + ' свободно'

// Виртуальная память:
PageFileTotalPanel.Color := clBlack
PageFileTotalPanel.Font.Color := clLime
PageFileTotalPanel.Text := ' ' + ByteOrTB(Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile)/oneMB, False) + ' всего, ' +
ByteOrTB((Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile) -
Size64(MemoryEx.HiAvailPageFile, MemoryEx.LoAvailPageFile))/oneMB, False) + ' занято системным кэшем'
if Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile)/oneMB < NeedPageFile then
begin
PageFileTotalPanel.Color := clBlack
PageFileTotalPanel.Font.Color := clRed
ChangeText := True
end

if ChangeText = True then
begin
TopText.Top := 0
TopText.Caption := 'Не все компоненты удовлетворяют требованиям игры.' #13
'Пожалуйста, проверьте позиции, выделенные красным цветом.'
TopText.Font.Name :='Georgia';
TopText.Font.Style:=[fsItalic];
TopText.Font.Color := clRed
// WizardForm.NextButton.Enabled := False
end
else
begin
TopText.Caption := 'Все компоненты соответствуют требованиям игры.'
TopText.Font.Name :='Georgia';
TopText.Font.Style:=[fsItalic];
TopText.Font.Color := clLime
TopText.Top := 8
// WizardForm.NextButton.Enabled := True
end
end;

procedure InitializeWizard5();
begin
InfoPage := CreateCustomPage(wpLicense, 'Аппаратное и программное обеспечение',
'Программа установки обнаружила следующие наобходимые компоненты.')
CreateCheckForm() // Создание объектов TMemo, в которых будет выводится информация о системе
UpdateInfo() // Обновление информации о системе
end;

procedure CurPageChanged2(CurPageID: Integer);
begin
PageNameLabel.Caption:= WizardForm.PageNameLabel.Caption;
PageDescriptionLabel.Caption:= WizardForm.PageDescriptionLabel.Caption;
if CurPageID = InfoPage.ID then UpdateInfo() // Обновление информации о системе
if CurPageID = wpSelectDir then GetFreeSpaceCaption(nil);
// ExtractTemporaryFile('Mod Gueri11as v.1.4.txt');
if IsTaskSelected('mod') then
if CurPageID = wpReady then
// ShellExec('', ExpandConstant('{tmp}\Mod Gueri11as v.1.4.txt'), '', '', SW_SHOW, ewNoWait, ErrorCode)
if ChangeText = False then
WizardForm.ReadyMemo.Lines.Add('Проверка системных требований:')
if ChangeText = False then
WizardForm.ReadyMemo.Lines.Add(' Все компоненты соответствуют требованиям игры')
if ChangeText = True then
WizardForm.ReadyMemo.Lines.Add('Проверка системных требований:')
if ChangeText = True then
WizardForm.ReadyMemo.Lines.Add(' Не все компоненты удовлетворяют требованиям игры')
if ChangeText = True then
WizardForm.ReadyMemo.Font.Color:= clred
end;

//******************************************* [Конец - Проверка сист. требований] ***************************************************//

//************************************************ [Музыка начало] ***************************************************//

function BASS_Init(device: Integer; freq, flags: DWORD; win: hwnd; CLSID: Integer): Boolean; external 'BASS_Init@files:BASS.dll stdcall delayload';
function BASS_StreamCreateFile(mem: BOOL; f: PAnsiChar; offset: DWORD; length: DWORD; flags: DWORD): DWORD; external 'BASS_StreamCreateFile@files:BASS.dll stdcall delayload';
function BASS_Start: Boolean; external 'BASS_Start@files:BASS.dll stdcall delayload';
function BASS_ChannelPlay(handle: DWORD; restart: BOOL): Boolean; external 'BASS_ChannelPlay@files:BASS.dll stdcall delayload';
function BASS_ChannelIsActive(handle: DWORD): Integer; external 'BASS_ChannelIsActive@files:BASS.dll stdcall delayload';
function BASS_ChannelPause(handle: DWORD): Boolean; external 'BASS_ChannelPause@files:BASS.dll stdcall delayload';
function BASS_Pause: Boolean; external 'BASS_Pause@files:BASS.dll stdcall delayload';
function BASS_Stop: Boolean; external 'BASS_Stop@files:BASS.dll stdcall delayload';
function BASS_Free: Boolean; external 'BASS_Free@files:BASS.dll stdcall delayload';

procedure MusicButtonClick(hBtn:HWND);
begin
if BtnGetChecked(MusicButton) then BASS_ChannelPause(mp3Handle)
else if BASS_ChannelIsActive(mp3Handle)=BASS_ACTIVE_PAUSED then BASS_ChannelPlay(mp3Handle, False);
end;

procedure InsertMusic;
begin
MusicButton:=BtnCreate(WizardForm.MainPanel.Handle,ScaleX(470),ScaleY(10),ScaleX(20),ScaleY(20),ExpandConstant('{tmp}\MusicButton.png'),0,True);
BtnSetEvent(MusicButton,BtnClickEventID,WrapBtnCallback(@MusicButtonClick,1));
BtnSetVisibility(MusicButton,True);
BtnSetCursor(MusicButton,GetSysCursorHandle(32649));

mp3Name:=ExpandConstant('{tmp}\Music.mp3');
BASS_Init(-1,44100,0,0,0);
mp3Handle:=BASS_StreamCreateFile(FALSE,PAnsiChar(mp3Name),0,0,BASS_SAMPLE_LOOP);
BASS_Start;
BASS_ChannelPlay(mp3Handle,False);
end;

//************************************************ [Музыка конец ***************************************************//

//******************************************* [ logo - Лого как ссылка внизу слева ] ***************************************************//

procedure LogoLabelOnClick(Sender: TObject);
var
ErrorCode: Integer;
begin
ShellExec('open', 'http://terabits.ru', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode)
end;

procedure InitializeWizard6();
begin
InsertMusic;
CreateComponents;
LogoPanel := TPanel.Create(WizardForm);
with LogoPanel do
begin
Parent := WizardForm;
Left := ScaleX(7);
Top := ScaleY(319);
Width := ScaleX(188);
Height := ScaleY(44);
BevelOuter := bvNone;
end;

LogoImage := TBitmapImage.Create(WizardForm);
with LogoImage do
begin
Parent := LogoPanel;
Left := ScaleX(0);
Top := ScaleY(0);
AutoSize:=true;
ReplaceColor:=clFuchsia;
ReplaceWithColor:=clBtnFace;
ExtractTemporaryFile('logo.bmp');
Bitmap.LoadFromFile(ExpandConstant('{tmp}\logo.bmp'));
end;

LogoLabel := TLabel.Create(WizardForm);
with LogoLabel do
begin
Parent := LogoPanel;
Width := LogoPanel.Width;
Height := LogoPanel.Height;
Transparent:=True;
Cursor := crHand;
OnClick:=@LogoLabelOnClick;
end;
end;

//******************************************* [ конец logo - Лого как ссылка внизу слева ] ***************************************************//

//************************************************ [Прогресс бар - начало] ***************************************************//

// Обработчик нажатия кнопки Отмена
procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
if CurPageID = wpInstalling then // Просто спрячем наш Прогресс Бар
ProgressBar_Edit.Show;
end;

// Функция вызываемая по таймеру
procedure OnTimer(HandleW, msg, idEvent, TimeSys: LongWord);
var
CurrWidth : single;
begin
// Используем текущее состояние стандартного Прогресс Бара (ПБ)
with WizardForm.ProgressGauge do
begin
CurrWidth := ( Position * Width ) / Max; // Вычисляем какой ширины должен быть наш ПБ
if intOldCurrWidth <> Round( CurrWidth ) then // Если ширина пока что такая же, то не будем пока что рисовать, чтобы избежать лишних обновлений формы
begin
intOldCurrWidth := Round( CurrWidth );
// Теперича "рисуем" наш ПБ
ProgressBar_BitmapImage.SetBounds( 0, 0, intOldCurrWidth, ProgressBar_ImageHeight );
ProgressBar_BitmapImage.Show(); // Показываем его во всей красе
end;
end;
end;

procedure CurPageChanged3(CurPageID: Integer);
var
pfunc: LongWord;
begin
if CurPageID = wpInstalling then
begin
// Устанавливаем таймер
pfunc := WrapTimerProc( @OnTimer, 4 );
TimerID := SetTimer( 0, 0, 100, pfunc );
intOldCurrWidth := 0;
end;

// Убираем таймер, когда находимся на последней странице.
if CurPageID = wpFinished then
KillTimer( 0, TimerID );
end;

Procedure InitializeWizard7();
begin
// Создаем наш Edit, чтобы у нашего ПБ была более-менее нормальная рамка.
ProgressBar_Edit := TEdit.Create( WizardForm );
with ProgressBar_Edit do
begin
// Создаем его на месте стандартного ПБ
Left := WizardForm.ProgressGauge.Left;
Top := WizardForm.ProgressGauge.Top;
Width := WizardForm.ProgressGauge.Width;
Height := WizardForm.ProgressGauge.Height;
Enabled := False;
ReadOnly := True;
// Фоновый цвет
Color := clBlack;
Parent := WizardForm.InstallingPage;
end;

// Распаковываем картинку для нашего ПБ
ExtractTemporaryFile( '{#PB_ImageFile}' );

ProgressBar_BitmapImage := TBitmapImage.Create( WizardForm );
with ProgressBar_BitmapImage do
begin
// Загружаем картинку
Bitmap.LoadFromFile( ExpandConstant( '{tmp}\' ) + '{#PB_ImageFile}' );
Parent := ProgressBar_Edit;
Stretch := True; // Он должен растягиваться
Hide; // Прячем его до поры до времени
end;

// Получаем высоту для картинки
ProgressBar_ImageHeight := ProgressBar_Edit.Height - 2;
// Прячем стандартный ПБ
WizardForm.ProgressGauge.Hide;
end;

//************************************************ [Прогресс бар - конец] ***************************************************//

procedure ReadEntries(); // читаем реестр
begin
RegQueryStringValue(HKCU, 'Software\TeraGames\Fifa 09', 'path', AppDir); // данные реестра
end;

function InitializeSetup: Boolean;
begin
ExtractTemporaryFile('botva2.dll');
ExtractTemporaryFile('MusicButton.png');
ExtractTemporaryFile('Music.mp3');
ExtractTemporaryFile('BASS.dll');
ExtractTemporaryFile('Grey&Black.cjstyles');
LoadSkin(ExpandConstant('{tmp}\Grey&Black.cjstyles'), '');
Result := True;

unins:='unins000.exe'; // исполняемый файл деинсталляции

if (RegValueExists(HKCU, 'Software\TeraGames\Fifa 09', 'path')) then // если находим в реестре нужное значение
begin
ReadEntries;
if (FileExists(AddBackslash(AppDir) + unins)) then
begin
Exec(AddBackslash(AppDir) + unins, '', ExtractFilePath(AddBackslash(AppDir) + unins), SW_SHOW, ewNoWait, ResultCode);
end else begin
MsgBox('Невозможно запустить деинсталляцию' + ExpandConstant('{#MyAppName}') + ', т.к. исполняемый файл программы не найден.', mbCriticalError, MB_OK or MB_DEFBUTTON1);
end;
Result:=False;
end;
end;

function InitializeUninstall(): Boolean;
begin
FileCopy(ExpandConstant('{app}\isskin.dll'), ExpandConstant('{tmp}\isskin.dll'), False);
FileCopy(ExpandConstant('{app}\Grey&Black.cjstyles'), ExpandConstant('{tmp}\Grey&Black.cjstyles'), False);
FileCopy(ExpandConstant('{app}\InnoCallback.dll'), ExpandConstant('{tmp}\InnoCallback.dll'), False);
LoadSkinUninst(ExpandConstant('{tmp}\Grey&Black.cjstyles'), '');
Result := True;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var ResultStr:String;
//Удаление сохранений
begin
if CurUninstallStep=usUninstall then
begin
RegQueryStringValue(HKCU, 'Software\Russobit\start\Xenus. White Gold', 'path', ResultStr)
if DirExists(ExpandConstant('{commondocs}')+'\White Gold') then
if MsgBox(ExpandConstant('{cm:DeleteSave}'),mbconfirmation, mb_YesNo) = IDYES then
begin
if not DelTree(ExpandConstant('{commondocs}')+'\White Gold', True, True, True) then
MsgBox('Папка не удалена!' #13#13 'Папка не существует или задействованна.', mbError, MB_OK);
end;
end;
end;

procedure DeInitializeSetup();
begin
ShowWindow(StrToInt(ExpandConstant('{wizardhwnd}')), 0);
UnloadSkin();
BASS_Stop;
BASS_Free;
KillTimer( 0, TimerID );
end;

procedure DeinitializeUninstall();
begin
UnloadSkinUninst();
end;

Procedure InitializeWizard();
begin
InitializeWizard1();
InitializeWizard2();
InitializeWizard3();
InitializeWizard4();
InitializeWizard5();
InitializeWizard6();
InitializeWizard7();
end;

procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged1(CurPageID);
CurPageChanged2(CurPageID);
CurPageChanged3(CurPageID);
end;
[/more]
где здесть строка отвечающая за цвет текста на странице приветствия и завершения?
Автор: troyan90
Дата сообщения: 12.08.2010 13:32
TonyJef
разницы нет
одно скажу зачем делать авторан в инно, когда для этого куча рограмм существует
Автор: TonyJef
Дата сообщения: 12.08.2010 13:40

Цитата:
Подробнее...
где здесть строка отвечающая за текст на странице приветствия и завершения?

помогите плз
Автор: solomon94
Дата сообщения: 12.08.2010 13:57
А как добавить кнопку выключения звука как у Юршата?
Автор: ChanVS
Дата сообщения: 12.08.2010 14:01
TonyJef
Font.Color:=ClWhite; // Белый!
Автор: Flamech
Дата сообщения: 12.08.2010 14:01
TonyJef

Цитата:
где здесть строка отвечающая за цвет текста на странице приветствия и завершения?

Меняй значения четырёх первых Font.Color
Автор: TonyJef
Дата сообщения: 12.08.2010 14:53
спс
Автор: troyan90
Дата сообщения: 12.08.2010 14:58
Hitman 2.1 Final + isdone



Скачать:
http://rghost.ru/2326841
Автор: TonyJef
Дата сообщения: 12.08.2010 15:20
скрипт классный,но было бы там все секции кроме кода,как в том скрипте который у меня,а то в этом я не разобрался) ну так получается что не все поймут)))
Автор: solomon94
Дата сообщения: 12.08.2010 15:42
Троян молодец прикольный скрипт!
Автор: ChanVS
Дата сообщения: 12.08.2010 17:51
Не ужеле так сложно с моей проблемой?
[more]
procedure CurStepChanged1(CurStep: TSetupStep);
begin
case CurStep of
ssInstall: begin
if GetArrayLength(ADisk)>0 then begin
KillTimer(WizardForm.Handle,WFDiskTimerID);
    SetArrayLength(ADisk,0);
end;
if GetArrayLength(ASysReq)>0 then begin
KillTimer(WizardForm.Handle,WFSysReqTimerID);
    SetArrayLength(ASysReq,0);
end;

WizardForm.ProgressGauge.Visible:=False;

OldPosition:=0;
CurrentImage:=0;
ImgSetVisibility(WizardImg,False);
ImgSetVisibility(AImg[0],True);

ExtractTemporaryFile('ProgressBackground.png');
ExtractTemporaryFile('ProgressImg.png');
ExtractTemporaryFile('ProgressImg2.png');
NewPB:=ImgPBCreate(WizardForm.Handle, ExpandConstant('{tmp}\ProgressBackground.png'), ExpandConstant('{tmp}\ProgressImg.png'),ScaleX(119),ScaleY(300),ScaleX(560),ScaleY(25));
NewPB2:=ImgPBCreate(WizardForm.Handle, ExpandConstant('{tmp}\ProgressBackground.png'), ExpandConstant('{tmp}\ProgressImg2.png'),ScaleX(119),ScaleY(400),ScaleX(350),ScaleY(25)); //создает дорожку 2
NewPB3:=ImgPBCreate(WizardForm.Handle, ExpandConstant('{tmp}\ProgressBackground.png'), ExpandConstant('{tmp}\ProgressImg2.png'),ScaleX(479),ScaleY(400),ScaleX(200),ScaleY(25)); //создает дорожку 3 рядом

ImgApplyChanges(WizardForm.Handle);
     sTime:=GetTickCount;
eTime:=sTime;
ProgressStep:=100 div GetArrayLength(AImg);

PBOldProc:=SetWindowLong(WizardForm.ProgressGauge.Handle,-4,CallBackProc(@PBProc,4));
end;
ssPostInstall: AllCancel;
end;
end;
[/more]

Созданые 2 дорожки связать с процессоми
[more]
procedure RecodePCF;
var
ResultCode: integer; CurFile: String;

begin
ExtractTemporaryFile('precomp.exe'); ExtractTemporaryFile('packjpg_dll.dll')
ExtractTemporaryFile('ProgressImg2.png');
FindFiles(ExpandConstant('{app}'), '*.pcf')
Files:= StringToArray(S, '|')
WizardForm.ProgressGauge.Max:= GetArrayLength(Files);
StatusLabel.Caption:='Рекомпрессия извлеченного файла...';

for n:=(GetArrayLength(Files)-1) downto 0 do begin
FileCopy(ExpandConstant('{tmp}\precomp.exe'),AddBackslash(ExtractFilePath(Files[n]))+'precomp.exe', False)
FileCopy(ExpandConstant('{tmp}\packjpg_dll.dll'),AddBackslash(ExtractFilePath(Files[n]))+'packjpg_dll.dll', False)
WizardForm.FilenameLabel.Caption:= Files[n];
Exec(AddBackslash(ExtractFilePath(Files[n]))+'precomp.exe', '-d '+AddQuotes(Files[n]), '', SW_Hide, EwWaitUntilTerminated, ResultCode)
//ProgressBar.Position:= ProgressBar.Position +1;
DeleteFile(Files[n])
DeleteFile(AddBackslash(ExtractFilePath(Files[n]))+'packjpg_dll.dll')
DeleteFile(AddBackslash(ExtractFilePath(Files[n]))+'precomp.exe')
end;
end;

procedure RecodeOgg;
var
ResultCode: integer; CurFile: String;

begin
FindFiles(ExpandConstant('{app}'), '*.ogg') //Находим все файлы по маске, в выбранной папке
Files:= StringToArray(S, '|') //Переводим в массив
StatusLabel.Caption:='Рекомпрессия звуковых файлов...'; //показует надпись


for m:=(GetArrayLength(Files)-1) downto 0 do begin
CurFile:= Files[m]
StringChange(CurFile, AddBackslash(ExpandConstant('{app}')), '')
Exec(ExpandConstant('{app}\oggdec.exe'), '-Q '+AddQuotes(CurFile), '', SW_Hide, EwWaitUntilTerminated, ResultCode) //Для каждого файла запускаем декодер
DeleteFile(Files[m]) //Удаляем ненужный файл
FilenameLabel.Caption:= Files[m];
//ProgressBar2.Position:= ProgressBar2.Position +1;
end;
DeleteFile(ExpandConstant('{app}\oggdec.exe'))
ImgPBDelete(NewPB);
ImgPBDelete(NewPB2);
ImgPBDelete(NewPB3);
end;
[/more]
Автор: SergiusPl
Дата сообщения: 12.08.2010 18:41
Hitman 2.1 Final + isdone удолялка папку не удаляет. Поправить можно, подскажите как? Скрипт симпотишный.
Автор: troyan90
Дата сообщения: 12.08.2010 19:07
SergiusPl
это если запускать деинсталятор из папки. а если из пуска то все удаляется
Автор: SergiusPl
Дата сообщения: 12.08.2010 19:18
troyan90 понятненько, спасибо!
Автор: Alexander61434
Дата сообщения: 12.08.2010 22:23
Народ, помогите пожалуйста. У меня со скриптами ИСДон ерунда какая-то...Не хочет СРеп распаковывать.
Инсталлятор просто берёт и закрывается, без каких либо ошибок. Использую Packers Show 3.2. Помогите пожалуйста, очень срочно нужно...
Автор: Profrager
Дата сообщения: 12.08.2010 22:47
Alexander61434
Возможно ты пакуешь не 1.5 версией Srep'а
Автор: Alexander61434
Дата сообщения: 12.08.2010 23:02
Да нет вроде...в пакерс шоу запихнул ехешник от 1.5...
Хотя, возможно, нужно юзать консольные команды...подскажите плз...
P.S. Извиняюсь, что пишу не в тот раздел.
Автор: Profrager
Дата сообщения: 12.08.2010 23:05
Alexander61434
покажи строки распаковки срепа из своего скрипта
Автор: nik1967
Дата сообщения: 13.08.2010 07:05
ChanVS
Мерси за авторан на инно - для общего развития. Чуть - чуть изменил, думаю так прикольнее будет
[more=авторан][Setup]
AppName=AutoRUN
VersionInfoDescription=AutoRUN
VersionInfoProductName=AutoRUN
AppVerName=AutoRUN
VersionInfoProductVersion=1.0.0.0
VersionInfoVersion=1.0.0.0
VersionInfoCompany=john
VersionInfoCopyright=Copyright © John
CreateAppDir=no
OutputDir=.
OutputBaseFilename=Autorun
SetupIconFile=Icon.ico

[Languages]
Name: Russian; MessagesFile: compiler:Default.isl

[Files]
Source: 1.bmp; Flags: dontcopy

[Messages]
SetupAppTitle=AutoRUN

[Code]
const
BM_CLICK = $00F5;

var
AutoRun: TSetupForm;
img1: TBitmapImage;
PlayButton, InstallButton, SupportButton, ReadmeButton, WebButton, ExitButton, UninstallButton: TButton;
AppPath,UninsPath: string;
ResultCode: Integer;
procedure CurPageChanged(CurPageID: Integer);
begin
If CurPageID=wpWelcome then
SendMessage(WizardForm.NextButton.Handle, BM_CLICK, 0, 0);
end;

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
Confirm:=False
Cancel:=True
end;

procedure PlayButtonClick(Sender: TObject);
var
exe: string;
begin
exe:='shift.exe';
if RegQueryStringValue(HKLM, 'SOFTWARE\Electronic Arts\Game','Install Dir', AppPath) then
begin
Exec(AddBackslash(AppPath) + Exe, '', ExtractFilePath(AddBackslash(AppPath) + Exe), SW_SHOWNORMAL,ewNoWait,ResultCode)
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end
end;

procedure InstallButtonClick(Sender: TObject);
var
CurPageID: Integer;
begin
Exec(ExpandConstant('{src}\Setup.exe'),'','',SW_SHOW,ewNoWait,ResultCode)
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end;

procedure SupportButtonClick(Sender: TObject);
begin
shellexec('open', ExpandConstant('{src}\Game.exe'), '', '',SW_SHOWNORMAL, ewnowait, ResultCode)
end;

procedure ReadmeButtonClick(Sender: TObject);
begin
ShellExec('open', ExpandConstant('{src}\readme.txt'),'','', SW_SHOW, ewNoWait, ResultCode)
end;

procedure WebButtonClick(Sender: TObject);
begin
shellexec('open', 'http://localhost', '', '',SW_SHOWNORMAL, ewnowait, ResultCode)
end;

procedure ExitButtonClick(Sender: TObject);
var
CurPageID: Integer;
begin
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end;

procedure UninstallButtonClick(Sender: TObject);
begin
if RegQueryStringValue(HKLM, 'SOFTWARE\Game','UninstallString', UninsPath) then
begin
UninsPath:=RemoveQuotes(UninsPath)
Exec(UninsPath,'','',SW_SHOWNORMAL,ewNoWait,ResultCode)
AutoRun.Close;
PostMessage(WizardForm.CancelButton.Handle, BM_CLICK, 0, 0);
end
end;

procedure CreateAutoRun;
begin
//AutoRun
AutoRun := CreateCustomForm;
with AutoRun do begin
Left := 498;
Top := 75;
Width := 495;
Height := 340;
BorderIcons := [];
BorderStyle:=bsToolWindow //(bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin)
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
Position := poScreenCenter;
Caption:='AutoRUN'
end;
//img1
img1 := TBitmapImage.Create(AutoRun);
ExtractTemporaryFile('1.bmp');
with img1 do begin
Parent := AutoRun;
Left := 0;
Stretch:= true;
Top := 0;
Width := Autorun.Width;
Height := Autorun.Height;
Bitmap.LoadFromFile(ExpandConstant('{tmp}\1.bmp'));
end;
//PlayButton
PlayButton:= TButton.Create(AutoRun);
with PlayButton do begin
Parent := AutoRun;
Left := 300;
Top := 110;
Width := 150;
Height := 22;
Caption:= 'Начать игру';
Cursor:= crHand;
// ModalResult:= mrOk;
OnClick := @PlayButtonClick;
if not RegQueryStringValue(HKLM, 'SOFTWARE\Game','Install Dir', AppPath) then
begin
PlayButton.Enabled := False;
end;
end;
//InstallButton
InstallButton:= TButton.Create(AutoRun);
with InstallButton do begin
Parent:= AutoRun;
Left := 300;
Top := 110;
Width := 150;
Height := 22;
Caption:= 'Установить игру';
Cursor:= crHand;
OnClick := @InstallButtonClick;
end;
//SupportButton
SupportButton:= TButton.Create(AutoRun);
with SupportButton do begin
Parent:= AutoRun;
Left := 300;
Top := 140;
Width := 150;
Height := 22;
Caption:= 'Инфо';
Cursor:= crHand;
OnClick := @SupportButtonClick;
end;
//ReadmeButton
ReadmeButton:= TButton.Create(AutoRun);
with ReadmeButton do begin
Parent:= AutoRun;
Left := 300;
Top := 170;
Width := 150;
Height := 22;
Caption:= 'Readme';
Cursor:= crHand;
OnClick := @ReadmeButtonClick;
end;
//WebButton
WebButton:= TButton.Create(AutoRun);
with WebButton do begin
Parent:= AutoRun;
Left := 300;
Top := 200;
Width := 150;
Height := 22;
Caption:= 'Веб-сайт';
Cursor:= crHand;
OnClick := @WebButtonClick;
end;
//ExitButton
ExitButton:= TButton.Create(AutoRun);
with ExitButton do begin
Parent:= AutoRun;
Left := 300;
Top := 260;
Width := 150;
Height := 22;
Caption:= 'Выход';
Cursor:= crHand;
OnClick := @ExitButtonClick;
// ModalResult:= mrCancel;
end;
//UninstallButton
UninstallButton:= TButton.Create(AutoRun);
with UninstallButton do begin
Parent:= AutoRun;
Left := 300;
Top := 230;
Width := 150;
Height := 22;
Caption:= 'Удалить игру';
Cursor:= crHand;
OnClick := @UninstallButtonClick;
end;

if not RegQueryStringValue(HKLM, 'SOFTWARE\Game','UninstallString', UninsPath) then
begin
InstallButton.Enabled:=true;
InstallButton.Visible:=true;
UninstallButton.Enabled:=false;
UninstallButton.Visible:=false;
end;
if RegQueryStringValue(HKLM, 'SOFTWARE\Game','UninstallString', UninsPath) then
begin
InstallButton.Enabled:=false;
InstallButton.Visible:=false;
UninstallButton.Enabled:=true;
UninstallButton.Visible:=true;
end;

AutoRun.ShowModal;
end;

procedure InitializeWizard;
begin
CreateAutoRun;
end;[/more]

Добавлено:
Profrager
Ух ты какой! Решил рекодингам свою разработку передать . А как же мы?
Я плакаль .
Автор: Alexander61434
Дата сообщения: 13.08.2010 08:55
Profrager, вота:

Код: function ISSRepExtract(CurComponent:longword; var OveralPct:integer; PctOfTotal:double; InName, OutFile, IdxFile: AnsiString; DeleteInFile:boolean; callback: longword):BOOL; external 'ISSrepExtract@files:ISDone.dll stdcall';
Автор: Profrager
Дата сообщения: 13.08.2010 09:01
nik1967

Цитата:
Ух ты какой! Реyшил рекодингам свою разработку передать . А как же мы?
А "простым смертным" все равно оно нафиг не надо. Зато в нужных руках послужит хорошим орудием. Да и желания выкладывать в общественность больше уже нет

Добавлено:
Alexander61434
ну это чисто из скрипта примера isdone. У тебя что те же имена файлов и папки?
Автор: Alexander61434
Дата сообщения: 13.08.2010 09:16
Profrager, именно так...
Кстати, что за разработки? Скриншотик не покажешь?
Автор: nik1967
Дата сообщения: 13.08.2010 09:20
Profrager
А мне, "простому смертному", очень бы пригодилось. У рекодингов фиг допросишься. У того же вольта. Эх, жаль.
Добавлено:

Цитата:
Да и желания выкладывать в общественность больше уже нет

А что так?
Alexander61434
[more] [/more]
Автор: SergiusPl
Дата сообщения: 13.08.2010 09:34
Вопросик. А скрипты выкладываемые менять, использовать то можно? А то я на радостях стянул Hitman 2.1, заточил под себя. А то может их просто, вроде как, для ознакомления выкладывают?
Автор: Profrager
Дата сообщения: 13.08.2010 09:39
Alexander61434
попробуй распаковать консольной версией срепа, если норм распакуется, кинь в пм icq и/или skype, там разберемся.

Добавлено:
nik1967
надо было в альфа-тестеры подаваться
Автор: nik1967
Дата сообщения: 13.08.2010 09:44
Profrager

Цитата:
надо было в альфа-тестеры подаваться

А сейчас уже поздно? Могу в бета-тестеры

Страницы: 1234567891011121314151617181920212223

Предыдущая тема: Skype (Часть 3)


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.