» Inno Setup (создание инсталяционных пакетов)
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]
Вот авторан кнопки передвигай сам!
[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]
Вот авторан кнопки передвигай сам!
troyan90,а АМВ сойдет?
Кто поможет с этим?
http://rghost.ru/2326118/image.png
1. Не показывет движение
2. Не показывает название файла в работе.
http://rghost.ru/2326118/image.png
1. Не показывет движение
2. Не показывает название файла в работе.
[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]
где здесть строка отвечающая за цвет текста на странице приветствия и завершения?
#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]
где здесть строка отвечающая за цвет текста на странице приветствия и завершения?
TonyJef
разницы нет
одно скажу зачем делать авторан в инно, когда для этого куча рограмм существует
разницы нет
одно скажу зачем делать авторан в инно, когда для этого куча рограмм существует
Цитата:
Подробнее...
где здесть строка отвечающая за текст на странице приветствия и завершения?
помогите плз
А как добавить кнопку выключения звука как у Юршата?
TonyJef
Font.Color:=ClWhite; // Белый!
Font.Color:=ClWhite; // Белый!
TonyJef
Цитата:
Меняй значения четырёх первых Font.Color
Цитата:
где здесть строка отвечающая за цвет текста на странице приветствия и завершения?
Меняй значения четырёх первых Font.Color
спс
скрипт классный,но было бы там все секции кроме кода,как в том скрипте который у меня,а то в этом я не разобрался) ну так получается что не все поймут)))
Троян молодец прикольный скрипт!
Не ужеле так сложно с моей проблемой?
[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]
[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]
Hitman 2.1 Final + isdone удолялка папку не удаляет. Поправить можно, подскажите как? Скрипт симпотишный.
SergiusPl
это если запускать деинсталятор из папки. а если из пуска то все удаляется
это если запускать деинсталятор из папки. а если из пуска то все удаляется
troyan90 понятненько, спасибо!
Народ, помогите пожалуйста. У меня со скриптами ИСДон ерунда какая-то...Не хочет СРеп распаковывать.
Инсталлятор просто берёт и закрывается, без каких либо ошибок. Использую Packers Show 3.2. Помогите пожалуйста, очень срочно нужно...
Инсталлятор просто берёт и закрывается, без каких либо ошибок. Использую Packers Show 3.2. Помогите пожалуйста, очень срочно нужно...
Alexander61434
Возможно ты пакуешь не 1.5 версией Srep'а
Возможно ты пакуешь не 1.5 версией Srep'а
Да нет вроде...в пакерс шоу запихнул ехешник от 1.5...
Хотя, возможно, нужно юзать консольные команды...подскажите плз...
P.S. Извиняюсь, что пишу не в тот раздел.
Хотя, возможно, нужно юзать консольные команды...подскажите плз...
P.S. Извиняюсь, что пишу не в тот раздел.
Alexander61434
покажи строки распаковки срепа из своего скрипта
покажи строки распаковки срепа из своего скрипта
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
Ух ты какой! Решил рекодингам свою разработку передать
. А как же мы?
Я плакаль
.
Мерси за авторан на инно - для общего развития. Чуть - чуть изменил, думаю так прикольнее будет
[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
Ух ты какой! Решил рекодингам свою разработку передать
. А как же мы? Я плакаль
.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';
Код: function ISSRepExtract(CurComponent:longword; var OveralPct:integer; PctOfTotal:double; InName, OutFile, IdxFile: AnsiString; DeleteInFile:boolean; callback: longword):BOOL; external 'ISSrepExtract@files:ISDone.dll stdcall';
nik1967
Цитата:
Добавлено:
Alexander61434
ну это чисто из скрипта примера isdone. У тебя что те же имена файлов и папки?
Цитата:
Ух ты какой! Реyшил рекодингам свою разработку передать . А как же мы?А "простым смертным" все равно оно нафиг не надо. Зато в нужных руках послужит хорошим орудием. Да и желания выкладывать в общественность больше уже нет
Добавлено:
Alexander61434
ну это чисто из скрипта примера isdone. У тебя что те же имена файлов и папки?
Profrager, именно так...
Кстати, что за разработки? Скриншотик не покажешь?
Кстати, что за разработки? Скриншотик не покажешь?
Profrager
А мне, "простому смертному", очень бы пригодилось. У рекодингов фиг допросишься. У того же вольта. Эх, жаль.
Добавлено:
Цитата:
А что так?
Alexander61434
[more]
[/more]
А мне, "простому смертному", очень бы пригодилось. У рекодингов фиг допросишься. У того же вольта. Эх, жаль.
Добавлено:
Цитата:
Да и желания выкладывать в общественность больше уже нет
А что так?
Alexander61434
[more]
[/more] Вопросик. А скрипты выкладываемые менять, использовать то можно? А то я на радостях стянул Hitman 2.1, заточил под себя. А то может их просто, вроде как, для ознакомления выкладывают?
Alexander61434
попробуй распаковать консольной версией срепа, если норм распакуется, кинь в пм icq и/или skype, там разберемся.
Добавлено:
nik1967
надо было в альфа-тестеры подаваться
попробуй распаковать консольной версией срепа, если норм распакуется, кинь в пм icq и/или skype, там разберемся.
Добавлено:
nik1967
надо было в альфа-тестеры подаваться
Profrager
Цитата:
А сейчас уже поздно? Могу в бета-тестеры
Цитата:
надо было в альфа-тестеры подаваться
А сейчас уже поздно? Могу в бета-тестеры
Страницы: 1234567891011121314151617181920212223
Предыдущая тема: Skype (Часть 3)
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.