TonyJef
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору #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; | Всего записей: 114 | Зарегистр. 05-06-2010 | Отправлено: 14:29 12-08-2010 | Исправлено: TonyJef, 14:41 12-08-2010 |
|