Цитата Habetdin:
Можно убить запуском команды
[архив] Скрипты Inno Setup. Помощь и советы [часть 2]
А это можно как-то в код добавить? Чтоб без батника.
[архив] Скрипты Inno Setup. Помощь и советы [часть 2]
-
Habetdin
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Habetdin,
Цитата Habetdin:
Можно убить запуском команды
А это можно как-то в код добавить? Чтоб без батника.
Цитата Habetdin:
Можно убить запуском команды
А это можно как-то в код добавить? Чтоб без батника.
-
j8r60
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Цитата МИШАНЧИК:
А это можно как-то в код добавить? Чтоб без батника.
Ага
Код:
А это можно как-то в код добавить? Чтоб без батника.
[архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Ага
Код:
Код: Выделить всё
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
ErrorCode: Integer;
begin
if CurUninstallStep = usUninstall then
begin
if RunTask('USBSRService.exe', false) then
Exec('taskkill', '/f /im USBSRService.exe', '', SW_HIDE, ewWaitUntilTerminated, ErrorCode);
UnloadDll(ExpandConstant('{app}\ISTask.dll'));
end;
end;-
superalex
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Такая проблема в папке maps большое количество файлов, примерно на 1GB после компиляции установщик весит 611мб. Проблема в том что после компиляции ярлык pack.ico не прикрепляется то есть устанавливается обычный системный ярлык. Проверял скрипт на нескольких файлах в папке - все нормально. Как сделать чтобы при больших количествах файлов прикреплялся нормально ярлык к установщику? Моя версия inno setup 5.3.9 unicode
код:
код:
Код: Выделить всё
[Setup]
AppName=BigMapPack
AppVersion=1.0
AppPublisher=Publisher
AppPublisherURL=http://www.site.ru./
AppVerName=BigMapPack version 1.0
DefaultDirName={pf}\Steam\SteamApps\<your steam login>
Compression=lzma2
SetupIconFile=pack.ico <------- этот ярлык не крепится при большом количестве файлов
WizardImageFile=logo.bmp
Uninstallable=no
[Files]
Source: "maps\*"; DestDir: "{app}\counter-strike source\cstrike\maps";
[Languages]
Name: "ru"; MessagesFile: "compiler:Languages\Russian.isl"
Name: "en"; MessagesFile: "compiler:Default.isl"
[Messages]
ru.SelectDirBrowseLabel=Вместо <your steam login> введите ваш логин в steam, программа сама установит в директорию с:\program files\steam\SteamApps\<ваш логин в steam>\counter-strike source\cstrike\maps
en.SelectDirBrowseLabel=Enter your steam login, end click next-
Henry_Townsend
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Цитата МИШАНЧИК:
А есть что-то подобное чтоб удалить в реестре всю ветку с подразделами
Код:
А есть что-то подобное чтоб удалить в реестре всю ветку с подразделами
[архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Код:
Код: Выделить всё
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
if CurUninstallStep = usPostUninstall then
RegDeleteKeyIncludingSubkeys(HKCU, 'Software\SafelyRemove');
end;-
somename
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Serega подскажи как сделать вот это
т.е. если игра установлена появлялось это окошко. Я так понял, что в Сталкере инсталл через этот
Root: HKLM; Subkey: "Software\GSC Game World\STALKER-SHOC"; ValueType: string; ValueName: "InstallPath"; ValueData: "{app}";
проверяет наличие экзешки (XR_3DA.exe), и если она есть запускается окошко, если нет - установка.
т.е. если игра установлена появлялось это окошко. Я так понял, что в Сталкере инсталл через этот
ключь
Root: HKLM; Subkey: "Software\GSC Game World\STALKER-SHOC"; ValueType: string; ValueName: "InstallPath"; ValueData: "{app}";
проверяет наличие экзешки (XR_3DA.exe), и если она есть запускается окошко, если нет - установка.
-
serg aka lain
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Цитата S.E.K.T.O.R.:
подскажи как сделать вот это
Код:
подскажи как сделать вот это
[архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Пример
Код:
Код: Выделить всё
[Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
OutputDir=.
Compression=lzma/ultra
InternalCompressLevel=ultra
SolidCompression=yes
[Languages]
Name: rus; MessagesFile: compiler:Languages\Russian.isl
[Files]
Source: compiler:Examples\MyProg.exe; DestDir: {app}; Flags: ignoreversion
[Registry]
Root: HKLM; Subkey: Software\My Program; ValueType: string; ValueName: InstallPath; ValueData: {app}; Flags: uninsdeletekey
[Code]
function InitializeSetup: Boolean;
var
path: string;
res: Integer;
begin
Result:= True;
if RegValueExists(HKLM, 'Software\My Program', 'InstallPath') then
if RegQueryStringValue(HKLM, 'Software\My Program', 'InstallPath', path) then
if FileExists(path + '\MyProg.exe') then
if MsgBox('Запустить My Program?', mbConfirmation, MB_YESNO) = IDYES then
begin
Exec(path + '\MyProg.exe', '', '', SW_SHOW, ewWaitUntilTerminated, res);
Result:= False;
end;
end;-
Serega
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Serega большое спасибо 
Только можно, чтоб при нажатии кнопки "Нет" инсталл закрывался, а не продолжал установку
Только можно, чтоб при нажатии кнопки "Нет" инсталл закрывался, а не продолжал установку
-
Tukash
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
yamaha
вот тебе музыка
[Files]
Source: C:\sound.mp3; DestDir: {tmp}; Flags: dontcopy noencryption nocompression
Source: C:\BASS.dll; DestDir: {tmp}; Flags: dontcopy noencryption
Source: C:\MusicButton.bmp; DestDir: {tmp}; Flags: dontcopy (прилепил)
[_Code]
const
Archives = '{src}\*.arc'; // укажите расположение архивов FreeArc; для внешних файлов строку в [Files] добавлять необязательно
PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMb = 1048576;
type
#ifdef UNICODE ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup
#define A "W"
#else
#define A "A" ; точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
PAnsiChar = PChar; // Required for Inno Setup 5.3.0 and higher. (требуется для Inno Setup версии 5.3.0 и ниже)
#endif
#if Ver < 84018176
AnsiString = String; // There is no need for this line in Inno Setup 5.2.4 and above (для Inno Setup версий 5.2.4 и выше эта строка не нужна)
#endif
TMyMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path: string; OrigSize: Integer; Size: Extended; end;
var
ExtractFile: TLabel;
lblExtractFileName: TLabel;
btnCancelUnpacking: TButton;
CancelCode, n, UnPackError, StartInstall: Integer;
Arcs: array of TArc;
msgError: string;
lastMb: Integer;
baseMb: Integer;
totalUncompressedSize: Integer; // total uncompressed size of archive data in mb
LastTimerEvent: DWORD;
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: string; cbMultiByte: integer; lpWideCharStr: string; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: string; cchWideChar: integer; lpMultiByteStr: string; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';
function PeekMessage(var lpMsg: TMyMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMyMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMyMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetTickCount: DWord; external 'GetTickCount@kernel32';
function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl';
procedure AppProcessMessage;
var
Msg: TMyMsg;
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
// Перевод числа в строку с точностью 3 знака (%.3n) с округлением дробной части, если она есть
Function NumToStr(Float: Extended): String;
Begin
Result:= Format('%.3n', [Float]); StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Length(Result) > 1) do
SetLength(Result, Length(Result)-1);
End;
function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo;
if Lo= 0 then Result:= origsize;
except
Result:= -63; // ArcFail
end;
end;
// Scans the specified folders for archives and add them to list
function FindArcs(dir: string): Extended;
var
FSR: TFindRec;
Begin
Result:= 0;
if FindFirst(ExpandConstant(dir), FSR) then begin
try
repeat
// Skip everything but the folders
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
n:= GetArrayLength(Arcs);
// Expand the folder list
SetArrayLength(Arcs, n +1);
Arcs[n].Path:= ExtractFilePath(ExpandConstant(dir)) + FSR.Name;
Arcs[n].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Result:= Result + Arcs[n].Size;
Arcs[n].OrigSize := ArchiveOrigSize(Arcs[n].Path)
totalUncompressedSize := totalUncompressedSize + Arcs[n].OrigSize
until not FindNext(FSR);
finally
FindClose(FSR);
end;
end;
End;
// Sets the TaskBar title
Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
h:= GetWindowLong(MainForm.Handle, -8); if h 0 then SetWindowText(h, Title);
End;
// Converts milliseconds to human-readable time
// Конвертирует милисекунды в человеко-читаемое изображение времени
Function TicksToTime(Ticks: DWord; h,m,s: String; detail: Boolean): String;
Begin
if detail {hh:mm:ss format} then
Result:= PADZ(IntToStr(Ticks/3600000), 2) +':'+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +':'+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2)
else if Ticks/3600 >= 1000 {more than hour} then
Result:= IntToStr(Ticks/3600000) +h+' '+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +m
else if Ticks/60 >= 1000 {1..60 minutes} then
Result:= IntToStr(Ticks/60000) +m+' '+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2) +s
else Result:= IntToStr(Ticks/1000) +s {less than one minute}
End;
// The main callback function for unpacking FreeArc archives
function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
percents, Remaining: Integer;
s: String;
begin
if GetTickCount - LastTimerEvent > 1000 then begin
// This code will be executed once each 1000 ms (этот код будет выполняться раз в 1000 миллисекунд)
// ....
// End of code executed by timer
LastTimerEvent := LastTimerEvent+1000;
end;
if string(what)='filename' then begin
// Update FileName label
lblExtractFileName.Caption:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
end else if (string(what)='write') and (totalUncompressedSize>0) and (Mb>lastMb) then begin
// Assign to Mb *total* amount of data extracted to the moment from all archives
lastMb := Mb;
Mb := baseMb+Mb;
// Update progress bar
WizardForm.ProgressGauge.Position:= Mb;
// Show how much megabytes/archives were processed up to the moment
percents:= (Mb*1000) div totalUncompressedSize;
s := FmtMessage(cm('ExtractedInfo'), [IntToStr(Mb), IntToStr(totalUncompressedSize)]);
if GetArrayLength(Arcs)>1 then
s := s + '. '+FmtMessage(cm('ArcInfo'), [IntToStr(n+1), IntToStr(GetArrayLength(Arcs))])
ExtractFile.Caption := s
// Calculate and show current percents
percents:= (Mb*1000) div totalUncompressedSize;
s:= FmtMessage(cm('AllProgress'), [Format('%.1n', [Abs(percents/10)])]);
if Mb > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((totalUncompressedSize - Mb)/Mb)) else Remaining:= 0;
if Remaining = 0 then SetTaskBarTitle(cm('ending')) else begin
s:= s + '. '+FmtMessage(cm('remains'), [TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)])
SetTaskBarTitle(FmtMessage(cm('taskbar'), [IntToStr(percents/10), TicksToTime(Remaining, 'h', 'm', 's', false)]))
end;
WizardForm.FileNameLabel.Caption := s
end;
AppProcessMessage;
Result:= CancelCode;
end;
// Extracts all found archives
function UnPack(Archives: string): Integer;
var
totalCompressedSize: Extended;
callback: longword;
FreeMB, TotalMB: Cardinal;
begin
// Display 'Extracting FreeArc archive'
lblExtractFileName.Caption:= '';
lblExtractFileName.Show;
ExtractFile.caption:= cm('ArcTitle');
ExtractFile.Show;
// Show the 'Cancel unpacking' button and set it as default button
btnCancelUnpacking.Caption:= WizardForm.CancelButton.Caption;
btnCancelUnpacking.Show;
WizardForm.ActiveControl:= btnCancelUnpacking;
WizardForm.ProgressGauge.Position:= 0;
// Get the size of all archives
totalUncompressedSize := 0;
totalCompressedSize := FindArcs(Archives);
WizardForm.ProgressGauge.Max:= totalUncompressedSize;
// Other initializations
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
StartInstall:= GetTickCount; {время начала распаковки}
LastTimerEvent:= GetTickCount;
baseMb:= 0
for n:= 0 to GetArrayLength(Arcs) -1 do
begin
lastMb := 0
CancelCode:= 0;
AppProcessMessage;
try
// Pass the specified arguments to 'unarc.dll'
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', AnsiToUtf8(Arcs[n].Path), '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;
baseMb:= baseMb+lastMb
// Error occured
if Result 0 then
begin
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
GetSpaceOnDisk(ExtractFileDrive(ExpandConstant('{app}')), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < 32 {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Arcs[n].Path)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
// MsgBox(msgError, mbInformation, MB_OK); //сообщение показывается на странице завершения
Log(msgError);
Break; //прервать цикл распаковки
end;
end;
// Hide labels and button
WizardForm.FileNameLabel.Caption:= '';
lblExtractFileName.Hide;
ExtractFile.Hide;
btnCancelUnpacking.Hide;
end;
procedure CurStepChanged1(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
UnPackError:= UnPack(Archives)
if UnPackError = 0 then
SetTaskBarTitle(SetupMessage(msgSetupAppTitle))
else
begin
// Error occured, uninstall it then
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); //откат установки из-за ошибки unarc.dll
SetTaskBarTitle(SetupMessage(msgErrorTitle))
WizardForm.Caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
end;
end;
end;
// стандартный способ отката (не нужна CurPageChanged1), но архивы распаковываются до извлечения файлов инсталлятора
// 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
WizardForm.FinishedLabel.Font.Color:= $0000C0; // red (красный)
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + msgError;
end;
End;
procedure InitializeWizard1();
begin
with WizardForm.ProgressGauge do
begin
// Create a label to show current FileName being extracted
lblExtractFileName:= TLabel.Create(WizardForm);
lblExtractFileName.parent:=WizardForm.InstallingPage;
lblExtractFileName.autosize:=false;
lblExtractFileName.Width:= Width;
lblExtractFileName.top:=Top + ScaleY(35);
lblExtractFileName.Caption:= '';
lblExtractFileName.Hide;
// Create a label to show percentage
ExtractFile:= TLabel.Create(WizardForm);
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width:= Width;
ExtractFile.top:=lblExtractFileName.Top + ScaleY(16);
ExtractFile.caption:= '';
ExtractFile.Hide;
end;
// Create a 'Cancel unpacking' button and hide it for now.
btnCancelUnpacking:=TButton.create(WizardForm);
btnCancelUnpacking.Parent:= WizardForm;
btnCancelUnpacking.SetBounds(WizardForm.CancelButton.Left, WizardForm.CancelButton.top, WizardForm.CancelButton.Width, WizardForm.CancelButton.Height);
btnCancelUnpacking.OnClick:= @btnCancelUnpackingOnClick;
btnCancelUnpacking.Hide;
end;
const
BASS_ACTIVE_PLAYING = 1;
BASS_ACTIVE_STALLED = 2;
BASS_ACTIVE_PAUSED = 3;
BASS_SAMPLE_LOOP = 4;
var
mp3Handle: HWND;
mp3Name: String;
PlayButton, PauseButton, StopButton: TPanel;
PlayImage, PauseImage: TBitmapImage;
PlayLabel, PauseLabel: TLabel;
MouseLabel: Tlabel;
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: PChar; 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_Free(): Boolean;
external 'BASS_Free@files:BASS.dll stdcall delayload';
procedure PlayMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PlayImage.Left := -101
end;
procedure PlayMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PlayImage.Left := 5
end;
procedure PlayMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if PlayImage.Left -101 then PlayImage.Left := -197
end;
procedure PauseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PauseImage.Left := -133
end;
procedure PauseMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PauseImage.Left := -37
end;
procedure PauseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if PauseImage.Left -133 then PauseImage.Left := -229
end;
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
PlayImage.Left := -5
PauseImage.Left := -37
end;
function InitializeSetup2(): Boolean;
begin
ExtractTemporaryFile('BASS.dll');
ExtractTemporaryFile('sound.mp3');
mp3Name := ExpandConstant('{tmp}\sound.mp3');
BASS_Init(-1, 44100, 0, 0, 0);
mp3Handle := BASS_StreamCreateFile(FALSE, PChar(mp3Name), 0, 0, BASS_SAMPLE_LOOP);
BASS_Start();
BASS_ChannelPlay(mp3Handle, False);
Result := True;
end;
procedure PlayButtonOnClick(Sender: TObject);
begin
case BASS_ChannelIsActive(mp3Handle) of
BASS_ACTIVE_PAUSED:
begin
BASS_ChannelPlay(mp3Handle, False);
PlayButton.Hide
PauseButton.Show
end;
end;
end;
procedure PauseButtonOnClick(Sender: TObject);
begin
BASS_ChannelPause(mp3Handle);
PauseButton.Hide
PlayButton.Show
end;
procedure InitializeWizard2();
begin
ExtractTemporaryFile('MusicButton.bmp')
MouseLabel := TLabel.Create(WizardForm)
MouseLabel.Width := WizardForm.Width
MouseLabel.Height := WizardForm.Height
MouseLabel.Autosize := False
MouseLabel.Transparent := True
MouseLabel.OnMouseMove := @MouseMove
MouseLabel.Parent := WizardForm
PlayButton := TPanel.Create(WizardForm)
PlayButton.Left :=0
PlayButton.Top :=313
PlayButton.Width := 23
PlayButton.Height := 22
PlayButton.Cursor := crHand
PlayButton.ShowHint := True
PlayButton.Hint := 'Воспроизвести'
PlayButton.OnClick := @PlayButtonOnClick
PlayButton.Parent := WizardForm
PlayImage := TBitmapImage.Create(WizardForm)
PlayImage.Left := 0
PlayImage.Top := 0
PlayImage.Width := 288
PlayImage.Height := 22
PlayImage.Enabled := False
PlayImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\MusicButton.bmp'))
PlayImage.Parent := PlayButton
//
PlayImage.ReplaceColor:=$E2E2E2
PlayImage.ReplaceWithColor:=clBtnFace
PlayLabel := TLabel.Create(WizardForm)
PlayLabel.Width := PlayButton.Width
PlayLabel.Height := PlayButton.Height
PlayLabel.Autosize := False
PlayLabel.Transparent := True
PlayLabel.OnClick := @PlayButtonOnClick
PlayLabel.OnMouseDown := @PlayMouseDown
PlayLabel.OnMouseUp := @PlayMouseUp
PlayLabel.OnMouseMove := @PlayMouseMove
PlayLabel.Parent := PlayButton
PauseButton := TPanel.Create(WizardForm)
PauseButton.Left :=0
PauseButton.Top := 313
PauseButton.Width := 23
PauseButton.Height := 22
PauseButton.Cursor := crHand
PauseButton.ShowHint := True
PauseButton.Hint := 'Приостановить'
PauseButton.OnClick := @PauseButtonOnClick
PauseButton.Parent := WizardForm
PauseImage := TBitmapImage.Create(WizardForm)
PauseImage.Left := -37
PauseImage.Top := 0
PauseImage.Width := 288
PauseImage.Height := 22
PauseImage.Enabled := False
PauseImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\MusicButton.bmp'))
PauseImage.Parent := PauseButton
//
PauseImage.ReplaceColor:=$E2E2E2
PauseImage.ReplaceWithColor:=clBtnFace
PauseLabel := TLabel.Create(WizardForm)
PauseLabel.Width := PauseButton.Width
PauseLabel.Height := PauseButton.Height
PauseLabel.Autosize := False
PauseLabel.Transparent := True
PauseLabel.OnClick := @PauseButtonOnClick
PauseLabel.OnMouseDown := @PauseMouseDown
PauseLabel.OnMouseUp := @PauseMouseUp
PauseLabel.OnMouseMove := @PauseMouseMove
PauseLabel.Parent := PauseButton
end;
procedure DeinitializeSetup2();
begin
BASS_Free();
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
CurStepChanged1(CurStep);
end;
procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged1(CurPageID);
end;
procedure InitializeWizard();
begin
InitializeWizard1();
InitializeWizard2();
end;
function InitializeSetup(): Boolean;
begin
Result := InitializeSetup2(); if not Result then exit;
end;
procedure DeinitializeSetup();
begin
DeinitializeSetup2();
end;
вот тебе музыка
читать дальше »
[Files]
Source: C:\sound.mp3; DestDir: {tmp}; Flags: dontcopy noencryption nocompression
Source: C:\BASS.dll; DestDir: {tmp}; Flags: dontcopy noencryption
Source: C:\MusicButton.bmp; DestDir: {tmp}; Flags: dontcopy (прилепил)
[_Code]
const
Archives = '{src}\*.arc'; // укажите расположение архивов FreeArc; для внешних файлов строку в [Files] добавлять необязательно
PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMb = 1048576;
type
#ifdef UNICODE ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup
#define A "W"
#else
#define A "A" ; точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
PAnsiChar = PChar; // Required for Inno Setup 5.3.0 and higher. (требуется для Inno Setup версии 5.3.0 и ниже)
#endif
#if Ver < 84018176
AnsiString = String; // There is no need for this line in Inno Setup 5.2.4 and above (для Inno Setup версий 5.2.4 и выше эта строка не нужна)
#endif
TMyMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path: string; OrigSize: Integer; Size: Extended; end;
var
ExtractFile: TLabel;
lblExtractFileName: TLabel;
btnCancelUnpacking: TButton;
CancelCode, n, UnPackError, StartInstall: Integer;
Arcs: array of TArc;
msgError: string;
lastMb: Integer;
baseMb: Integer;
totalUncompressedSize: Integer; // total uncompressed size of archive data in mb
LastTimerEvent: DWORD;
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: string; cbMultiByte: integer; lpWideCharStr: string; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: string; cchWideChar: integer; lpMultiByteStr: string; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';
function PeekMessage(var lpMsg: TMyMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMyMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMyMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetTickCount: DWord; external 'GetTickCount@kernel32';
function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl';
procedure AppProcessMessage;
var
Msg: TMyMsg;
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
// Перевод числа в строку с точностью 3 знака (%.3n) с округлением дробной части, если она есть
Function NumToStr(Float: Extended): String;
Begin
Result:= Format('%.3n', [Float]); StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Length(Result) > 1) do
SetLength(Result, Length(Result)-1);
End;
function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
Function Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo;
if Lo= 0 then Result:= origsize;
except
Result:= -63; // ArcFail
end;
end;
// Scans the specified folders for archives and add them to list
function FindArcs(dir: string): Extended;
var
FSR: TFindRec;
Begin
Result:= 0;
if FindFirst(ExpandConstant(dir), FSR) then begin
try
repeat
// Skip everything but the folders
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
n:= GetArrayLength(Arcs);
// Expand the folder list
SetArrayLength(Arcs, n +1);
Arcs[n].Path:= ExtractFilePath(ExpandConstant(dir)) + FSR.Name;
Arcs[n].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Result:= Result + Arcs[n].Size;
Arcs[n].OrigSize := ArchiveOrigSize(Arcs[n].Path)
totalUncompressedSize := totalUncompressedSize + Arcs[n].OrigSize
until not FindNext(FSR);
finally
FindClose(FSR);
end;
end;
End;
// Sets the TaskBar title
Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
h:= GetWindowLong(MainForm.Handle, -8); if h 0 then SetWindowText(h, Title);
End;
// Converts milliseconds to human-readable time
// Конвертирует милисекунды в человеко-читаемое изображение времени
Function TicksToTime(Ticks: DWord; h,m,s: String; detail: Boolean): String;
Begin
if detail {hh:mm:ss format} then
Result:= PADZ(IntToStr(Ticks/3600000), 2) +':'+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +':'+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2)
else if Ticks/3600 >= 1000 {more than hour} then
Result:= IntToStr(Ticks/3600000) +h+' '+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +m
else if Ticks/60 >= 1000 {1..60 minutes} then
Result:= IntToStr(Ticks/60000) +m+' '+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2) +s
else Result:= IntToStr(Ticks/1000) +s {less than one minute}
End;
// The main callback function for unpacking FreeArc archives
function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
percents, Remaining: Integer;
s: String;
begin
if GetTickCount - LastTimerEvent > 1000 then begin
// This code will be executed once each 1000 ms (этот код будет выполняться раз в 1000 миллисекунд)
// ....
// End of code executed by timer
LastTimerEvent := LastTimerEvent+1000;
end;
if string(what)='filename' then begin
// Update FileName label
lblExtractFileName.Caption:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
end else if (string(what)='write') and (totalUncompressedSize>0) and (Mb>lastMb) then begin
// Assign to Mb *total* amount of data extracted to the moment from all archives
lastMb := Mb;
Mb := baseMb+Mb;
// Update progress bar
WizardForm.ProgressGauge.Position:= Mb;
// Show how much megabytes/archives were processed up to the moment
percents:= (Mb*1000) div totalUncompressedSize;
s := FmtMessage(cm('ExtractedInfo'), [IntToStr(Mb), IntToStr(totalUncompressedSize)]);
if GetArrayLength(Arcs)>1 then
s := s + '. '+FmtMessage(cm('ArcInfo'), [IntToStr(n+1), IntToStr(GetArrayLength(Arcs))])
ExtractFile.Caption := s
// Calculate and show current percents
percents:= (Mb*1000) div totalUncompressedSize;
s:= FmtMessage(cm('AllProgress'), [Format('%.1n', [Abs(percents/10)])]);
if Mb > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((totalUncompressedSize - Mb)/Mb)) else Remaining:= 0;
if Remaining = 0 then SetTaskBarTitle(cm('ending')) else begin
s:= s + '. '+FmtMessage(cm('remains'), [TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)])
SetTaskBarTitle(FmtMessage(cm('taskbar'), [IntToStr(percents/10), TicksToTime(Remaining, 'h', 'm', 's', false)]))
end;
WizardForm.FileNameLabel.Caption := s
end;
AppProcessMessage;
Result:= CancelCode;
end;
// Extracts all found archives
function UnPack(Archives: string): Integer;
var
totalCompressedSize: Extended;
callback: longword;
FreeMB, TotalMB: Cardinal;
begin
// Display 'Extracting FreeArc archive'
lblExtractFileName.Caption:= '';
lblExtractFileName.Show;
ExtractFile.caption:= cm('ArcTitle');
ExtractFile.Show;
// Show the 'Cancel unpacking' button and set it as default button
btnCancelUnpacking.Caption:= WizardForm.CancelButton.Caption;
btnCancelUnpacking.Show;
WizardForm.ActiveControl:= btnCancelUnpacking;
WizardForm.ProgressGauge.Position:= 0;
// Get the size of all archives
totalUncompressedSize := 0;
totalCompressedSize := FindArcs(Archives);
WizardForm.ProgressGauge.Max:= totalUncompressedSize;
// Other initializations
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
StartInstall:= GetTickCount; {время начала распаковки}
LastTimerEvent:= GetTickCount;
baseMb:= 0
for n:= 0 to GetArrayLength(Arcs) -1 do
begin
lastMb := 0
CancelCode:= 0;
AppProcessMessage;
try
// Pass the specified arguments to 'unarc.dll'
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', AnsiToUtf8(Arcs[n].Path), '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;
baseMb:= baseMb+lastMb
// Error occured
if Result 0 then
begin
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
GetSpaceOnDisk(ExtractFileDrive(ExpandConstant('{app}')), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < 32 {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Arcs[n].Path)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
// MsgBox(msgError, mbInformation, MB_OK); //сообщение показывается на странице завершения
Log(msgError);
Break; //прервать цикл распаковки
end;
end;
// Hide labels and button
WizardForm.FileNameLabel.Caption:= '';
lblExtractFileName.Hide;
ExtractFile.Hide;
btnCancelUnpacking.Hide;
end;
procedure CurStepChanged1(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
UnPackError:= UnPack(Archives)
if UnPackError = 0 then
SetTaskBarTitle(SetupMessage(msgSetupAppTitle))
else
begin
// Error occured, uninstall it then
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); //откат установки из-за ошибки unarc.dll
SetTaskBarTitle(SetupMessage(msgErrorTitle))
WizardForm.Caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
end;
end;
end;
// стандартный способ отката (не нужна CurPageChanged1), но архивы распаковываются до извлечения файлов инсталлятора
// 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
WizardForm.FinishedLabel.Font.Color:= $0000C0; // red (красный)
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + msgError;
end;
End;
procedure InitializeWizard1();
begin
with WizardForm.ProgressGauge do
begin
// Create a label to show current FileName being extracted
lblExtractFileName:= TLabel.Create(WizardForm);
lblExtractFileName.parent:=WizardForm.InstallingPage;
lblExtractFileName.autosize:=false;
lblExtractFileName.Width:= Width;
lblExtractFileName.top:=Top + ScaleY(35);
lblExtractFileName.Caption:= '';
lblExtractFileName.Hide;
// Create a label to show percentage
ExtractFile:= TLabel.Create(WizardForm);
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width:= Width;
ExtractFile.top:=lblExtractFileName.Top + ScaleY(16);
ExtractFile.caption:= '';
ExtractFile.Hide;
end;
// Create a 'Cancel unpacking' button and hide it for now.
btnCancelUnpacking:=TButton.create(WizardForm);
btnCancelUnpacking.Parent:= WizardForm;
btnCancelUnpacking.SetBounds(WizardForm.CancelButton.Left, WizardForm.CancelButton.top, WizardForm.CancelButton.Width, WizardForm.CancelButton.Height);
btnCancelUnpacking.OnClick:= @btnCancelUnpackingOnClick;
btnCancelUnpacking.Hide;
end;
const
BASS_ACTIVE_PLAYING = 1;
BASS_ACTIVE_STALLED = 2;
BASS_ACTIVE_PAUSED = 3;
BASS_SAMPLE_LOOP = 4;
var
mp3Handle: HWND;
mp3Name: String;
PlayButton, PauseButton, StopButton: TPanel;
PlayImage, PauseImage: TBitmapImage;
PlayLabel, PauseLabel: TLabel;
MouseLabel: Tlabel;
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: PChar; 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_Free(): Boolean;
external 'BASS_Free@files:BASS.dll stdcall delayload';
procedure PlayMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PlayImage.Left := -101
end;
procedure PlayMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PlayImage.Left := 5
end;
procedure PlayMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if PlayImage.Left -101 then PlayImage.Left := -197
end;
procedure PauseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PauseImage.Left := -133
end;
procedure PauseMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PauseImage.Left := -37
end;
procedure PauseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if PauseImage.Left -133 then PauseImage.Left := -229
end;
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
PlayImage.Left := -5
PauseImage.Left := -37
end;
function InitializeSetup2(): Boolean;
begin
ExtractTemporaryFile('BASS.dll');
ExtractTemporaryFile('sound.mp3');
mp3Name := ExpandConstant('{tmp}\sound.mp3');
BASS_Init(-1, 44100, 0, 0, 0);
mp3Handle := BASS_StreamCreateFile(FALSE, PChar(mp3Name), 0, 0, BASS_SAMPLE_LOOP);
BASS_Start();
BASS_ChannelPlay(mp3Handle, False);
Result := True;
end;
procedure PlayButtonOnClick(Sender: TObject);
begin
case BASS_ChannelIsActive(mp3Handle) of
BASS_ACTIVE_PAUSED:
begin
BASS_ChannelPlay(mp3Handle, False);
PlayButton.Hide
PauseButton.Show
end;
end;
end;
procedure PauseButtonOnClick(Sender: TObject);
begin
BASS_ChannelPause(mp3Handle);
PauseButton.Hide
PlayButton.Show
end;
procedure InitializeWizard2();
begin
ExtractTemporaryFile('MusicButton.bmp')
MouseLabel := TLabel.Create(WizardForm)
MouseLabel.Width := WizardForm.Width
MouseLabel.Height := WizardForm.Height
MouseLabel.Autosize := False
MouseLabel.Transparent := True
MouseLabel.OnMouseMove := @MouseMove
MouseLabel.Parent := WizardForm
PlayButton := TPanel.Create(WizardForm)
PlayButton.Left :=0
PlayButton.Top :=313
PlayButton.Width := 23
PlayButton.Height := 22
PlayButton.Cursor := crHand
PlayButton.ShowHint := True
PlayButton.Hint := 'Воспроизвести'
PlayButton.OnClick := @PlayButtonOnClick
PlayButton.Parent := WizardForm
PlayImage := TBitmapImage.Create(WizardForm)
PlayImage.Left := 0
PlayImage.Top := 0
PlayImage.Width := 288
PlayImage.Height := 22
PlayImage.Enabled := False
PlayImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\MusicButton.bmp'))
PlayImage.Parent := PlayButton
//
PlayImage.ReplaceColor:=$E2E2E2
PlayImage.ReplaceWithColor:=clBtnFace
PlayLabel := TLabel.Create(WizardForm)
PlayLabel.Width := PlayButton.Width
PlayLabel.Height := PlayButton.Height
PlayLabel.Autosize := False
PlayLabel.Transparent := True
PlayLabel.OnClick := @PlayButtonOnClick
PlayLabel.OnMouseDown := @PlayMouseDown
PlayLabel.OnMouseUp := @PlayMouseUp
PlayLabel.OnMouseMove := @PlayMouseMove
PlayLabel.Parent := PlayButton
PauseButton := TPanel.Create(WizardForm)
PauseButton.Left :=0
PauseButton.Top := 313
PauseButton.Width := 23
PauseButton.Height := 22
PauseButton.Cursor := crHand
PauseButton.ShowHint := True
PauseButton.Hint := 'Приостановить'
PauseButton.OnClick := @PauseButtonOnClick
PauseButton.Parent := WizardForm
PauseImage := TBitmapImage.Create(WizardForm)
PauseImage.Left := -37
PauseImage.Top := 0
PauseImage.Width := 288
PauseImage.Height := 22
PauseImage.Enabled := False
PauseImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\MusicButton.bmp'))
PauseImage.Parent := PauseButton
//
PauseImage.ReplaceColor:=$E2E2E2
PauseImage.ReplaceWithColor:=clBtnFace
PauseLabel := TLabel.Create(WizardForm)
PauseLabel.Width := PauseButton.Width
PauseLabel.Height := PauseButton.Height
PauseLabel.Autosize := False
PauseLabel.Transparent := True
PauseLabel.OnClick := @PauseButtonOnClick
PauseLabel.OnMouseDown := @PauseMouseDown
PauseLabel.OnMouseUp := @PauseMouseUp
PauseLabel.OnMouseMove := @PauseMouseMove
PauseLabel.Parent := PauseButton
end;
procedure DeinitializeSetup2();
begin
BASS_Free();
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
CurStepChanged1(CurStep);
end;
procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged1(CurPageID);
end;
procedure InitializeWizard();
begin
InitializeWizard1();
InitializeWizard2();
end;
function InitializeSetup(): Boolean;
begin
Result := InitializeSetup2(); if not Result then exit;
end;
procedure DeinitializeSetup();
begin
DeinitializeSetup2();
end;
-
EN130
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Цитата Lancer2404:
как соединять несколько скриптов?У меня два кода а как соединить не знаю
Используй программу InnoSetup Script Joiner. Ссылка есть в шапке.
как соединять несколько скриптов?У меня два кода а как соединить не знаю
[архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Используй программу InnoSetup Script Joiner. Ссылка есть в шапке.
-
Serega
Re: [архив] Скрипты Inno Setup. Помощь и советы [часть 2]
Serega помоги пожалуйста сделать следующее:
Проверку операционной системы из зтого
Проверку операционной системы из зтого
скрипта
Код: Выделить всё
var state: boolean;
const
NeedSize = 20;
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVEABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
ListBox: TListBox;
Text: TNewStaticText;
function GetLogicalDrives: DWORD;
external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(nDrive: string): Longint;
external 'GetDriveTypeA@kernel32.dll stdcall';
function GetVideoCardName(): PChar;
external 'hwc_GetVideoCardName@files:get_hw_caps.dll stdcall';
function GetSoundCardName(): PChar;
external 'hwc_GetSoundCardName@files:get_hw_caps.dll stdcall';
function DetectHardware(): Integer;
external 'hwc_DetectHardware@files:get_hw_caps.dll stdcall';
function GetHardDriveFreeSpace(hdd: integer): Integer;
external 'hwc_GetHardDriveFreeSpace@files:get_hw_caps.dll stdcall';
function GetHardDriveName(hdd: integer): PChar;
external 'hwc_GetHardDriveName@files:get_hw_caps.dll stdcall';
function GetHardDriveTotalSpace(hdd: integer): Integer;
external 'hwc_GetHardDriveTotalSpace@files:get_hw_caps.dll stdcall';
function GetHardDrivesCount(): Integer;
external 'hwc_GetHardDrivesCount@files:get_hw_caps.dll stdcall';
function GetSoundCards(): Integer;
external 'hwc_GetSoundCards@files:get_hw_caps.dll stdcall';
function GetSystemPage(): Integer;
external 'hwc_GetSystemPage@files:get_hw_caps.dll stdcall';
function GetSystemPhys(): Integer;
external 'hwc_GetSystemPhys@files:get_hw_caps.dll stdcall';
function GetVidMemLocal(): Integer;
external 'hwc_GetVidMemLocal@files:get_hw_caps.dll stdcall';
function GetVidMemNonLocal(): Integer;
external 'hwc_GetVidMemNonLocal@files:get_hw_caps.dll stdcall';
function GetVideoCardDev(): Integer;
external 'hwc_GetVideoCardDev@files:get_hw_caps.dll stdcall';
function GetVideoCardVen(): Integer;
external 'hwc_GetVideoCardVen@files:get_hw_caps.dll stdcall';
function DelSp(const s: string): string; // функция удаления пробелов в начале строки
var
c, i: integer;
stt, st, st1: string;
begin
c := 0;
st := s;
for i := 1 to Length(st) do
begin
stt := copy(st, i, 1);
if (stt = ' ') and (c >= 1) then
begin
st1 := st1;
c := c + 1;
end
else if (stt = ' ') and (c = 0) then
begin
c := c + 1;
st1 := st1 + stt;
end
else if (stt ' ') then
begin
c := 0;
st1 := st1 + stt;
end
end;
Result := st1;
end;
procedure ListBoxOnClick(Sender: TObject);
var
NewLetter, OldString: string;
i: Integer;
begin
for i := 0 to ListBox.Items.Count - 1 do
begin
if ListBox.Selected[i] then
begin
NewLetter := Copy(ListBox.Items[i], 0, 1);
OldString := Copy(WizardForm.DirEdit.Text, 2, Length(WizardForm.DirEdit.Text));
WizardForm.DirEdit.Text := NewLetter + OldString;
end;
end;
end;
procedure InitializeWizard();
var
Page: TWizardPage;
Text: TNewStaticText;
Memo: TMemo;
Path: string;
FreeMB, TotalMB: Cardinal;
drives: DWORD;
i: integer;
begin
Text := TNewStaticText.Create(WizardForm);
Text.Top := 102;
Text.Width := 332;
Text.Height := 14;
Text.Caption := 'Список жестких дисков и свободного места';
Text.Parent := WizardForm.SelectDirPage;
ListBox := TListBox.Create(WizardForm);
ListBox.Top := 120;
ListBox.Width := 332;
ListBox.Height := ScaleY(90);
ListBox.Parent := WizardForm.SelectDirPage;
ListBox.OnClick := @ListBoxOnClick;
ListBox.Font.Name := 'Courier New';
ListBox.Font.Size := 10;
ListBox.Font.Style := [fsBold];
ListBox.Color := clBtnFace;
drives := GetLogicalDrives();
for i := 0 to 31 do
begin
if (drives and (1 shl i)) > 0 then
begin
Path := chr(ord('A') + i) + ':\';
if GetDriveType(Path) = DRIVE_FIXED then
begin
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB>1024 then ListBox.Items.Add(Path + ' ' + IntToStr(round(FreeMB / TotalMB * 100)) + '% ' + floatToStr(round(FreeMB/1024*100)/100) + ' GB')
else ListBox.Items.Add(Path + ' ' + IntToStr(round(FreeMB / TotalMB * 100)) + '% ' + IntToStr(FreeMB) + ' MB');
end;
end;
end;
end;
function NextButtonClick(CurPageID: Integer): Boolean;
var
Path,s: String;
FreeMB, TotalMB: Cardinal;
begin
Result:= True;
if CurPageID = wpSelectDir then
begin
Path:= ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB < (NeedSize*1024) then
begin
if FreeMB>1024 then
begin
s:='Для установки приложения необходимо '+ IntTostr(NeedSize)+ ' GB,'#13+'а на выбранном Вами диске доступно только '+ floatToStr(round(FreeMB/1024*100)/100) + ' GB!'
end
else s:='Для установки приложения необходимо '+ IntTostr(NeedSize)+ ' GB,'#13+'а на выбранном Вами диске доступно только '+ + IntToStr(FreeMB)+' MB';
MsgBox(s, mbCriticalError, MB_OK)
Result := False;
end;
end;
end;
procedure CurPageChanged(CurPageID: Integer);
var
Page: TWizardPage;
Text: TNewStaticText;
Memo,Windows,SP,Version,Build,registered,WindowsName,SP_Num,Version_Num,Build_num,registered_name: TMemo;
Os,OS1: string; // строка с названием необходимой ОС
// state: boolean;
ProcessorName: string;
Processor, VideoCardPanel, AudioCardPanel, RAMPanel, PageFilePanel: TMemo;
ProcessorNamePanel, VideoCardNamePanel, AudioCardNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;
ProcessorMHZ: Cardinal;
StaticText, StaticText2: TNewStaticText;
VidRam: integer;
begin
if CurPageID = wpUserInfo then
begin
//подменяем сраницу информации о пользователе на информацию об ОС
wizardForm.UserInfoNameEdit.visible:=false;
wizardForm.UserInfoNameEdit.text:='Игрок'; //на случай, когда имя пользователя не указано в системе
wizardForm.UserInfoNameLabel.visible:=false;
wizardForm.UserInfoOrgLabel.visible:=false;
wizardForm.UserInfoOrgEdit.visible:=false;
wizardForm.UserInfoOrgEdit.text:='Группа игроков ';//на случай, когда организация не указано в системе
wizardForm.PageNameLabel.Caption := 'Аппаратное обеспечение и Операционная система';
wizardForm.PageDescriptionLabel.Caption := 'Программа установки обнаружила следующие необходимые компоненты и Операционную систему ';
RegQueryStringValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', 'ProcessorNameString', ProcessorName);
RegQueryDWordValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', '~MHz', ProcessorMHZ);
OS:=' Microsoft Windows XP Service Pack 2'; //строка является суммой из записей в реестре о Наименовании ОС и сервис-паке
OS1:=' Microsoft Windows 2000 Service Pack 4'; //строка является суммой из записей в реестре о Наименовании ОС и сервис-паке
Windows := TMemo.Create(WizardForm);
StaticText := TNewStaticText.Create(TNewStaticText.Create(WizardForm));
with StaticText do begin
Left := 0;
Top := 52;
Width := 417;
Height := 14;
Caption := 'Все компоненты удовлетворяют требованиям игры.';
Parent := WizardForm.UserInfoPage;
StaticText.font.color:=clGreen;
end
with Windows do
begin
Text := ' Операц. система';
Parent := WizardForm.UserInfoPage;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(20);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end
Processor := TMemo.Create(WizardForm);
with Processor do begin
Text := ' Процессор';
Parent := WizardForm.UserInfoPage;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(77);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end
VideoCardPanel := TMemo.Create(WizardForm);
with VideoCardPanel do begin
Text := ' Видеоадаптер';
Parent := WizardForm.UserInfoPage;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(104);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end
AudioCardPanel := TMemo.Create(WizardForm);
with AudioCardPanel do begin
Text := ' Звуковая карта';
Parent := WizardForm.UserInfoPage;
Color := clBtnFace;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(131);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
end
RAMPanel := TMemo.Create(WizardForm);
with RAMPanel do begin
Text := ' ОЗУ';
Parent := WizardForm.UserInfoPage;
Color := clBtnFace;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(158);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
end
PageFilePanel := TMemo.Create(WizardForm);
with PageFilePanel do begin
Text := ' Файл подкачки';
Parent := WizardForm.UserInfoPage;
Color := clBtnFace;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(185);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
ProcessorNamePanel := TMemo.Create(WizardForm);
with ProcessorNamePanel do begin
Text := DelSP(ProcessorName) + ' ' + IntToStr(ProcessorMHZ) + 'MHz'; //новое обработанное значение строки
Parent := WizardForm.UserInfoPage;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(77);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
if ProcessorMHZ < 1800 then
begin
ProcessorNamePanel.Color := $ccccff;
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
StaticText.font.color:=clRed;
end;
VideoCardNamePanel := TMemo.Create(WizardForm);
with VideoCardNamePanel do begin
Text := ' ' + GetVideoCardName; //+' ОЗУ-'+inttostr(round(GetVidMemLocal/1000000))+' МБ'
Parent := WizardForm.UserInfoPage;
VidrAM := GetVidMemLocal / 1000000;
if VidRam > 127 then
begin
if VidRam < 200 then text := text + ' ОЗУ - 128 МB'
else if VidRam < 300 then text := text + ' ОЗУ - 256 МB'
else if VidRam < 400 then text := text + ' ОЗУ - 384 МB'
else if VidRam > 500 then text := text + ' ОЗУ - 512 МB';
end;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(104);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
if GetVidMemLocal < 127000000 then //128 MB
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
StaticText.font.color:=clRed;
VideoCardNamePanel.Color := $ccccff;
end;
end
AudioCardNamePanel := TMemo.Create(WizardForm);
with AudioCardNamePanel do begin
Text := ' ' + GetSoundCardName;
Parent := WizardForm.UserInfoPage;
Color := $CCFFCC;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(131);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R
ReadOnly := True;
end
RAMTotalPanel := TMemo.Create(WizardForm);
with RAMTotalPanel do begin
Text := ' ' + IntToStr(GetSystemPhys + 1) + ' MB';
Parent := WizardForm.UserInfoPage;
Color := $CCFFCC;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(158);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
if GetSystemPhys + 1 < 1024 then
begin
RAMTotalPanel.Color := $ccccff;
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
StaticText.font.color:=clRed;
end;
end;
PageFileTotalPanel := TMemo.Create(WizardForm);
with PageFileTotalPanel do begin
Text := ' ' + IntToStr(GetSystemPage) + ' MB';
Parent := WizardForm.UserInfoPage;
Color := $CCFFCC;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(185);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
if GetSystemPage < 1247 then
begin
PageFileTotalPanel.Color := $ccccff;
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
StaticText.font.color:=clRed;
end;
end;
end
if ExpandConstant('{reg:HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion,ProductName|}')='' then
begin
WindowsName := TMemo.Create(WizardForm);
with WindowsName do begin
Text := ExpandConstant(' {reg:HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion,ProductName|}')+ExpandConstant(' {reg:HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion,CSDVersion|}');
Parent := WizardForm.UserInfoPage;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(20);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
end
end
end;
// Проверка Windows 9x
if ExpandConstant('{reg:HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion,ProductName|}')'' then
begin
WindowsName := TMemo.Create(WizardForm);
with WindowsName do begin
Text := ExpandConstant(' {reg:HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion,ProductName|}')+ExpandConstant(' {reg:HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion,CSDVersion|}');
Parent := WizardForm.UserInfoPage;
Color := $CCFFCC;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(20);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
end
end;
if OS=(WindowsName.Text) then state:=true else
if OS1=(WindowsName.Text) then state:=true else state:=false;
Text := TNewStaticText.Create(WizardForm);
with Text do begin
Left := 0;
Top := 0;
Width := 417;
Height := 14;
if state then
begin
Font.Color:=clGreen;
WindowsName.color:=$CCFFCC;
// SP_Num.color:=$CCFFCC;
Caption := 'Операционная система соответствует требованиям игры.';
end
else
begin
Font.Color:=clREd;
WindowsName.color:=clRed;
WindowsName.Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
WindowsName.Top := ScaleY(20);
WindowsName.Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
WindowsName.Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
WindowsName.ReadOnly := True;
Caption := 'Операционная система не соответствует требованиям игры.';
end
Parent := WizardForm.UserInfoPage;
end
Text := TNewStaticText.Create(TNewStaticText.Create(WizardForm));
with Text do begin
Left := 0;
Top := 220;
Width := 417;
Height := 14;
Caption := 'Когда Вы будете готовы продолжить установку, нажмите «Далее».';
Parent := WizardForm.UserInfoPage;
end
if not state then
begin
wizardForm.Nextbutton.enabled:=false;
end;
end;
end;
добавить в этот
[url=#]скрипт[/url]
[code]
const
NeedSize = 20;
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVEABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
ListBox: TListBox;
Text: TNewStaticText;
function GetVideoCardName(): PChar;
external 'hwc_GetVideoCardName@files:get_hw_caps.dll stdcall';
function GetSoundCardName(): PChar;
external 'hwc_GetSoundCardName@files:get_hw_caps.dll stdcall';
function DetectHardware(): Integer;
external 'hwc_DetectHardware@files:get_hw_caps.dll stdcall';
function GetHardDriveFreeSpace(hdd: integer): Integer;
external 'hwc_GetHardDriveFreeSpace@files:get_hw_caps.dll stdcall';
function GetHardDriveName(hdd: integer): PChar;
external 'hwc_GetHardDriveName@files:get_hw_caps.dll stdcall';
function GetHardDriveTotalSpace(hdd: integer): Integer;
external 'hwc_GetHardDriveTotalSpace@files:get_hw_caps.dll stdcall';
function GetHardDrivesCount(): Integer;
external 'hwc_GetHardDrivesCount@files:get_hw_caps.dll stdcall';
function GetSoundCards(): Integer;
external 'hwc_GetSoundCards@files:get_hw_caps.dll stdcall';
function GetSystemPage(): Integer;
external 'hwc_GetSystemPage@files:get_hw_caps.dll stdcall';
function GetSystemPhys(): Integer;
external 'hwc_GetSystemPhys@files:get_hw_caps.dll stdcall';
function GetVidMemLocal(): Integer;
external 'hwc_GetVidMemLocal@files:get_hw_caps.dll stdcall';
function GetVidMemNonLocal(): Integer;
external 'hwc_GetVidMemNonLocal@files:get_hw_caps.dll stdcall';
function GetVideoCardDev(): Integer;
external 'hwc_GetVideoCardDev@files:get_hw_caps.dll stdcall';
function GetVideoCardVen(): Integer;
external 'hwc_GetVideoCardVen@files:get_hw_caps.dll stdcall';
function GetLogicalDrives: DWORD;
external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(nDrive: string): Longint;
external 'GetDriveTypeA@kernel32.dll stdcall';
function DelSp(const s: string): string; //функция удаления табуляции и пробелов в начале строки
var
c, i: integer;
stt, st, st1: string;
begin
c := 0;
st := s;
for i := 1 to Length(st) do
begin
stt := copy(st, i, 1);
if (stt = ' ') and (c >= 1) then
begin
st1 := st1;
c := c + 1;
end
else if (stt = ' ') and (c = 0) then
begin
c := c + 1;
st1 := st1 + stt;
end
else if (stt ' ') then
begin
c := 0;
st1 := st1 + stt;
end
end;
Result := st1;
end;
function CheckSystemPage(PreviousPageId: Integer): Integer;
var
Page: TWizardPage;
ProcessorName: string;
Processor, VideoCardPanel, AudioCardPanel, RAMPanel, PageFilePanel: TMemo;
ProcessorNamePanel, VideoCardNamePanel, AudioCardNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;
ProcessorMHZ: Cardinal;
StaticText, StaticText2: TNewStaticText;
VidRam: integer;
begin
RegQueryStringValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', 'ProcessorNameString', ProcessorName);
RegQueryDWordValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', '~MHz', ProcessorMHZ);
GetVidMemLocal;
GetSoundCards;
Page := CreateCustomPage(PreviousPageId, 'Аппаратное Обеспечение', 'Программа установки обнаружила следующие необходимые компоненты');
StaticText := TNewStaticText.Create(Page);
with StaticText do
begin
Parent := Page.Surface;
Caption := 'Все компоненты удовлетворяют требованиям игры.';
Left := 0;
Top := 0;
AutoSize := True;
end;
StaticText2 := TNewStaticText.Create(Page);
with StaticText2 do
begin
Parent := Page.Surface;
Caption := 'Когда Вы будете готовы продолжить установку, нажмите «Далее».';
Left := 0;
Top := 220;
AutoSize := True;
end;
//******************************************* [Начало - Процессор] ***************************************************//
Processor := TMemo.Create(Page);
with Processor do
begin
Text := ' Процессор';
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(30);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end;
ProcessorNamePanel := TMemo.Create(Page);
with ProcessorNamePanel do
begin
Text := DelSP(ProcessorName) + ' ' + IntToStr(ProcessorMHZ) + 'MHz'; //новое обработанное значение строки
//Caption :=ProcessorName+' '+IntToStr(ProcessorMHZ)+'MHz' ;
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(30);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
end;
if ProcessorMHZ < 1800 then //Минимальное количество частоты в MHz
begin
StaticText.Caption := 'Компоненты, выделенные красным, не удовлетворяют требованиям игры.'#13+'Проверьте соответствие системным требованиям.';
ProcessorNamePanel.Color := $CCCCFF;
end;
//******************************************* [Конец - Процессор] ****************************************************//
//******************************************* [Начало - Видеоадаптер] ************************************************//
VideoCardPanel := TMemo.Create(Page);
with VideoCardPanel do
begin
Text := ' Видеоадаптер';
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := Processor.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end;
VideoCardNamePanel := TMemo.Create(Page);
with VideoCardNamePanel do
begin
Text := ' ' + GetVideoCardName; //+' ОЗУ-'+inttostr(round(GetVidMemLocal/1000000))+' МБ';
//Caption:=' ОЗУ-'+inttostr(GetVidMemLocal)+' МБ';
Alignment := taLeftJustify;
Parent := Page.Surface;
VidrAM := GetVidMemLocal / 1000000;
if VidRam > 127 then
begin
if VidRam < 200 then Text := Text + '128 МB'
else if VidRam < 300 then Text := Text + '256 МB'
else if VidRam < 400 then Text := Text + '384 МB'
else if VidRam > 500 then Text := Text + '512 МB';
end;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := VideoCardPanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
end;
if GetVidMemLocal < 127000000 then //Минимальное объем ОЗУ [в байтах] у видеоадаптера 128 MB
begin
StaticText.Caption := 'Компоненты, выделенные красным, не удовлетворяют требованиям игры.'#13+'Проверьте соответствие системным требованиям.';
VideoCardNamePanel.Color := $CCCCFF;
end;
//******************************************* [Конец - Видеоадаптер] *************************************************//
//******************************************* [Начало - Звуковая карта] **********************************************//
AudioCardPanel := TMemo.Create(Page);
with AudioCardPanel do
begin
Text := ' Звуковая карта';
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := VideoCardPanel.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end;
AudioCardNamePanel := TMemo.Create(Page);
with AudioCardNamePanel do
begin
Text := ' ' + GetSoundCardName;
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := AudioCardPanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
end;
if
GetSoundCards = 0 then
begin
StaticText.Caption := 'Компоненты, выделенные красным, не удовлетворяют требованиям игры.'#13+'Проверьте соответствие системным требованиям.';
AudioCardNamePanel.Color := $CCCCFF;
end;
//******************************************* [Конец - Звуковая карта] ***********************************************//
//******************************************* [Начало - ОЗУ] *********************************************************//
RAMPanel := TMemo.Create(Page);
with RAMPanel do
begin
Text := ' Память';
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := AudioCardPanel.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end;
RAMTotalPanel := TMemo.Create(Page);
with RAMTotalPanel do
begin
Text := ' ' + IntToStr(GetSystemPhys + 1) + ' MB';
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := RAMPanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
end;
if GetSystemPhys + 1 < 1024 then //Минимальное объем ОЗУ 1 Гб или 1024 Мб
begin
StaticText.Caption := 'Компоненты, выделенные красным, не удовлетворяют требованиям игры.'#13+'Проверьте соответствие системным требованиям.';
RAMTotalPanel.Color := $CCCCFF;
end;
//******************************************* [Конец - ОЗУ] **********************************************************//
//******************************************* [Начало - Файл подкачки] ***********************************************//
PageFilePanel := TMemo.Create(Page);
with PageFilePanel do
begin
Text := ' Файл подкачки';
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := RAMPanel.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := clBtnFace;
end;
PageFileTotalPanel := TMemo.Create(Page);
with PageFileTotalPanel do
begin
Text := ' ' + IntToStr(GetSystemPage) + ' MB';
Alignment := taLeftJustify;
Parent := Page.Surface;
Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := PageFilePanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.
ReadOnly := True;
Color := $CCFFCC;
end;
if GetSystemPage < 2048 then //Минимальное объем файла [в мегабайтах] подкачки 1 Гб или 1024 Мб
begin
StaticText.Caption := 'Компоненты, выделенные красным, не удовлетворяют требованиям игры.'#13+'Проверьте соответствие системным требованиям.';
PageFileTotalPanel.Color := $CCCCFF;
end;
Result := Page.ID;
end;
//******************************************* [Конец - Файл подкачки] ************************************************//
procedure ListBoxOnClick(Sender: TObject);
var
NewLetter, OldString: string;
i: Integer;
begin
for i := 0 to ListBox.Items.Count - 1 do
begin
if ListBox.Selected[i] then
begin
NewLetter := Copy(ListBox.Items[i], 0, 1);
OldString := Copy(WizardForm.DirEdit.Text, 2, Length(WizardForm.DirEdit.Text));
WizardForm.DirEdit.Text := NewLetter + OldString;
end;
end;
end;
procedure InitializeWizard();
var
Page: TWizardPage;
Text: TNewStaticText;
Memo: TMemo;
Path: string;
FreeMB, TotalMB: Cardinal;
drives: DWORD;
i: integer;
begin
CheckSystemPage(wpLicense);
Text := TNewStaticText.Create(WizardForm);
Text.Top := 110;
Text.Width := 332;
Text.Height := 14;
Text.Caption := 'Список жестких дисков и свободного места';
Text.Parent := WizardForm.SelectDirPage;
ListBox := TListBox.Create(WizardForm);
ListBox.Top := 128;
ListBox.Width := 208;
ListBox.Height := ScaleY(84);
ListBox.Parent := WizardForm.SelectDirPage;
ListBox.OnClick := @ListBoxOnClick;
ListBox.Font.Name := 'Courier New';
ListBox.Font.Size := 10;
ListBox.Font.Style := [fsBold];
ListBox.Color := clBtnFace;
drives := GetLogicalDrives();
for i := 0 to 31 do
begin
if (drives and (1 shl i)) > 0 then
begin
Path := chr(ord('A') + i) + ':\';
if GetDriveType(Path) = DRIVE_FIXED then
begin
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB>1024 then ListBox.Items.Add(Path + ' ' + IntToStr(round(FreeMB / TotalMB * 100)) + '% ' + floatToStr(round(FreeMB/1024*100)/100) + ' GB')
else ListBox.Items.Add(Path + ' ' + IntToStr(round(FreeMB / TotalMB * 100)) + '% ' + IntToStr(FreeMB) + ' MB');
end;
end;
end;
end;
чтобы получилось вот так
[url=http://radikal.ru/F/s61.radikal.ru/i172/0909/c8/5381501aa1f4.jpg.html][/url]
и если можно объединить код с проверкой ОС, типа этого [url=http://radikal.ru/F/i074.radikal.ru/0909/ea/15bdf0f349a5.jpg.html]
[/url]
Заранее большое спасибо [img]images/smilies/new/smile.gif[/img] [img]images/smilies/new/smile.gif[/img] [img]images/smilies/new/smile.gif[/img]