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

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

Автор: 999Kay666
Дата сообщения: 23.02.2009 16:13
Парни(девушки), большая просьба. Когда-то я встречал в форуме подобное письмо, но от кого кому- беспонятия.
Вопрос: На странице SelectDir(при выборе пути для устновки пиложения), инсталлятор выдаёт сообщеие "Папка УЖЕ СУЩЕСТВУЕТ, установить тута же?".
Как избавиться от этого сообщения??? (Если папка еже сеществует)

Генри и/или др.Братья откликнитесь!!!
Автор: kombat 77
Дата сообщения: 23.02.2009 16:19
999Kay666

Цитата:
"Папка УЖЕ СУЩЕСТВУЕТ, установить тута же?". Как избавиться от этого сообщения??? (Если папка еже сеществует)


[Setup]
DirExistsWarning=False
Автор: skeptik_vdm
Дата сообщения: 23.02.2009 16:19
999Kay666

Попробуй либо это DirExistsWarning=no либо это EnableDirDoesntExistWarning=false точно не помню!!!
Автор: LordVeider
Дата сообщения: 23.02.2009 20:49
Jetr0
[more=Решение][Code]
var
    inumber:integer;
    key:string;
    
function InitializeSetup(): Boolean;
begin
    inumber:=1;
    repeat
    key:='SOFTWARE\Programname\'+IntToStr(inumber);
    if RegKeyExists(HKLM, key)
    then inumber:=inumber+1;
    until not RegKeyExists(HKLM, key);
    result:=true;
end;

procedure CurStepChanged(CurStep: TSetupStep);
var
    s:string;
begin
    if CurStep=ssPostInstall then
    begin
        RegWriteStringValue(HKLM, key, 'Path', ExpandConstant('{app}'));
        s:=ExpandConstant('{app}')
        StringChangeEx(S, ':\', ':\|', True);
        SaveStringToFile(ExpandConstant('{app}')+'\config.ini', 'INSTALLATION_NUMBER='+IntToStr(inumber)+#13, true);
    end;
end;




Ну и не забыть при удалении программы прибивать нужную ветку реестра =)[/more]
Автор: milwaukeeman
Дата сообщения: 24.02.2009 07:14

Цитата:
milwaukeeman
Добавь еще одну строчку Extract7z - все элементарно


А при этой команде установка будет везде искать файлы с таким расщмрением в папке {src}?
Автор: Jetr0
Дата сообщения: 24.02.2009 15:41
LordVeider
Большое спасибо! Очень признателен.
Автор: 999Kay666
Дата сообщения: 24.02.2009 18:21
kombat 77
skeptik_vdm
Парни, я вас не забуду.
Автор: chelobey
Дата сообщения: 25.02.2009 10:53
cспрашивал пару страниц назад...

переделал скрипт...
результат: на странице выбора компонентов есть кнопка с текстурой, по нажатию которой появляется rtf описание компонента.
проблема: как сделать несколько кнопок (для каждого из компонентов) и...
как сделать так, чтобы отображалось название кнопки.

[more=вот мой код...]
Код: #define MyAppName "Program"
#define MyAppVerName "1.0"

[Setup]
AppName={#MyAppName}
AppVerName={#MyAppVerName}
DefaultDirName={pf}\Program 1.0

[Components]
Name: prog1; Description: program1; Types: var1; Flags: exclusive
Name: prog2; Description: program2; Types: var2; Flags: exclusive

[Types]
Name: var1; Description: prog1
Name: var2; Description: prog2; Flags: iscustom

[Files]

Source: Button1.bmp; Flags: dontcopy
Source: prog1.rtf; Flags: dontcopy
Source: prog2.rtf; Flags: dontcopy

[no][Code][/no]
var
Memo: TRichEditViewer;
CheckListBox: TNewCheckListBox;
CancelButton: TButton;

Check: Boolean;
i, CurPage: Integer;
InfoButton, UpdateButton: TButton;
InfoPage: TWizardPage;
InfoImage: TBitmapImage;



Procedure CheckFoldersOnClick(Sender: TObject);
Begin
if (InfoButton.Tag= 1) then begin

InfoButton.Caption:= 'Вернуться';
InfoButton.Cursor:= crDefault;
UpdateButton.Cursor:= crDefault;
CancelButton.Tag:= 1
end else
CancelButton.Tag:= 0
end;

Procedure UpdateButtonOnClick(Sender: TObject);

Begin
Check:=True;
end;

Procedure CloseInfo; Begin If InfoButton.Tag= 1 then InfoButton.OnClick(InfoButton) End;

Function BackButtonClick(CurPageID: Integer): Boolean;
Begin Result:= True CloseInfo End;

Function NextButtonClick(CurPageID: Integer): Boolean;
Begin If InfoButton.Tag= 1 then else Result:= True
if (i =wpWelcome) and (InfoButton.Tag= 1) then Result:= True
CloseInfo
end;

Procedure InfoButtonOnClick(Sender: TObject);
Begin
if InfoButton.Tag= 0 then begin
InfoPage:= CreateCustomPage(CurPage, 'Описание', '')

Memo := TRichEditViewer.Create(InfoPage);
Memo.Top := ScaleY(0);
Memo.Width := InfoPage.SurfaceWidth - ScaleX(0);;
Memo.Height := InfoPage.SurfaceHeight - ScaleY(0);
Memo.ScrollBars := ssVertical;
Memo.Parent := InfoPage.Surface;
Memo.Lines.LoadFromFile(ExpandConstant('{tmp}\prog1.rtf'));

UpdateButton:= TButton.Create(WizardForm);

with UpdateButton do begin
OnClick:= @UpdateButtonOnClick;
end;

UpdateButton.OnClick(UpdateButton);
WizardForm.NextButton.OnClick(WizardForm.NextButton);
InfoButton.Visible:= True

InfoButton.Caption:='Закрыть инфу';
InfoButton.Cursor:= crHand;
InfoButton.Tag:= 1;

end

else begin
InfoButton.Caption:= 'Описание';
InfoButton.Cursor:= crHelp;
InfoButton.Tag:= 0;

WizardForm.BackButton.OnClick(WizardForm.BackButton);
WizardForm.PageDescriptionLabel.Font.Color:= WizardForm.PageNameLabel.Font.Color
UpdateButton.Free
InfoPage.Free
end
End;

Procedure CurPageChanged(CurPageID: Integer);
Begin
CurPage:=CurPageID
if CurPageID=wpReady then begin WizardForm.ReadyMemo.ScrollBars:=ssVertical
end;
if CurPageID<>wpSelectComponents then begin InfoButton.Visible:= False
end;
if CurPageID=wpSelectComponents then begin InfoButton.Visible:= True
end;
end;


Procedure InitializeWizard;
Begin

ExtractTemporaryFile('prog1.rtf');

CancelButton:= WizardForm.CancelButton;
InfoButton:= TButton.Create(WizardForm);

with InfoButton do begin
Left:= WizardForm.ClientWidth - CancelButton.Left - CancelButton.Width;
Top:= CancelButton.Top;
Width:= 132;
Height:= 27;
Caption:= 'Описание';
ShowHint:=True;
OnClick:= @InfoButtonOnClick;
Parent:= WizardForm;

InfoImage:=TBitmapImage.Create(WizardForm)
with InfoImage do begin
AutoSize:=True
Enabled:=False
ExtractTemporaryFile('Button1.bmp')
Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\Button1.bmp')
Parent:=InfoButton
end;
end;
end;
Автор: CapsLocker996
Дата сообщения: 25.02.2009 14:16
Здравствуйте. Извиняюсь за глупый вопрос, но никак не пойму как это сделать.
Мой инсталлятор проверяет наличие определенной установленной программы и если она есть, то удаляет ее, инсталляция прерывается и юзер производит перезагрузку, чтобы программа нормально удалилась. И вот собственно вопрос: как сделатЬ чтобы сразу после перезагрузки автоматически запускался setup.exe ?

Автор: Unc1e
Дата сообщения: 25.02.2009 14:56
CapsLocker996, примерно так:
Код: [Registry]
Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"; ValueType: string; ValueName: "MyProg"; ValueData: "{srcexe}"
Автор: CapsLocker996
Дата сообщения: 25.02.2009 15:32
Unc1e Спасибо большое )
Автор: LordVeider
Дата сообщения: 25.02.2009 18:36
///
Автор: loginvovchyk
Дата сообщения: 26.02.2009 03:23
А как вам это?

Автор: SotM
Дата сообщения: 26.02.2009 07:46
loginvovchyk

Цитата:
А как вам это?

Отвратно! Кто ж такую огромную картинку кидает в форум?! Ссылку на фотку нельзя разве сделать то?

И в чем вопрос то?
Автор: JuNoS
Дата сообщения: 26.02.2009 17:19
Очень нужен скрипт от setup-а ArtMoney SE или Pro v7. Зарание спасибо!
Автор: mavzer12
Дата сообщения: 26.02.2009 19:01
Подскажите как можно реализовать распаковку 7z архива с помощью 7za.exe не через секцию Run а через Code lда и чтобы после распаковки продолжилась дораспаковка файлов
Автор: hackerandrey
Дата сообщения: 26.02.2009 23:01
помогите соеденить ти скрипты

[Files]
Source: "C:\BASS.dll"; DestDir: "{tmp}"; Flags: dontcopy
Source: "C:\01-OVERSEER-Doomsday.mp3"; DestDir: "{tmp}"; Flags: dontcopy

[Code]
//большее указание смотрите в дельфийских исходниках в архиве с библиотекой
сonst
BASS_SAMPLE_LOOP = 4; //повторение

type
HSTREAM = DWORD; //тип звукового потока

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): HSTREAM;
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_Stop(): Boolean;
external 'BASS_Stop@files:BASS.dll stdcall delayload';

function BASS_Free(): Boolean;
external 'BASS_Free@files:BASS.dll stdcall delayload';

procedure InitializeWizard();
var
Name1: string;
i: Integer;
begin
ExtractTemporaryFile('BASS.dll');
ExtractTemporaryFile('01-OVERSEER-Doomsday.mp3');
if BASS_Init(-1, 44100, 0, 0, 0) then
begin
BASS_Start();
Name1:=ExpandConstant('{tmp}\01-OVERSEER-Doomsday.mp3');
i:=BASS_StreamCreateFile(FALSE, PChar(Name1), 0, 0, 4);
if i <> 0 then
begin
BASS_ChannelPlay(i, True);
end;
end;
end;
procedure DeInitializeSetup();
begin
BASS_Stop(); //нужно для остановки проигрывания
BASS_Free(); //нужно для быстрой выгрузки библиотеки вместе с муз. файлом
end;

с этим

[Setup]
WindowVisible=no

[Files]
Source: "C:\background.bmp"; DestDir: "{tmp}"; Flags: dontcopy

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

procedure InitializeWizard();
var
width,height: Integer;
BackgroundBitmapImage: TBitmapImage;
s: string;
begin
ExtractTemporaryFile('background.bmp');
s:=ExpandConstant('{tmp}')+'\background.bmp';
WizardForm.Position:=poScreenCenter;
MainForm.BORDERSTYLE:=bsNone;
width:=GetSystemMetrics(0);
height:=GetSystemMetrics(1);
MainForm.Width:=width;
MainForm.Height:=height;
width:=MainForm.ClientWidth;
height:=MainForm.ClientHeight;
MainForm.Left := 0;
MainForm.Top := 0;
BackgroundBitmapImage := TBitmapImage.Create(MainForm);
BackgroundBitmapImage.Bitmap.LoadFromFile(s);
BackgroundBitmapImage.Align := alClient;
BackgroundBitmapImage.Parent := MainForm;
BackgroundBitmapImage.Stretch:=True;
MainForm.Visible:=True;
end;
Автор: noiseless
Дата сообщения: 27.02.2009 08:05
hackerandrey
[more]
[Setup]
WindowVisible=no

[Files]
Source: "C:\background.bmp"; DestDir: "{tmp}"; Flags: dontcopy
Source: "C:\BASS.dll"; DestDir: "{tmp}"; Flags: dontcopy
Source: "C:\01-OVERSEER-Doomsday.mp3"; DestDir: "{tmp}"; Flags: dontcopy

[Code]
сonst
BASS_SAMPLE_LOOP = 4; //повторение

type
HSTREAM = DWORD; //тип звукового потока

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): HSTREAM;
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_Stop(): Boolean;
external 'BASS_Stop@files:BASS.dll stdcall delayload';

function BASS_Free(): Boolean;
external 'BASS_Free@files:BASS.dll stdcall delayload';

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

procedure InitializeWizard();

var
Name1: string;
i: Integer;
width,height: Integer;
BackgroundBitmapImage: TBitmapImage;
s: string;
begin
ExtractTemporaryFile('background.bmp');
ExtractTemporaryFile('BASS.dll');
ExtractTemporaryFile('01-OVERSEER-Doomsday.mp3');
if BASS_Init(-1, 44100, 0, 0, 0) then
begin
BASS_Start();
Name1:=ExpandConstant('{tmp}\01-OVERSEER-Doomsday.mp3');
i:=BASS_StreamCreateFile(FALSE, PChar(Name1), 0, 0, 4);
if i <> 0 then
begin
BASS_ChannelPlay(i, True);
end;
end;
s:=ExpandConstant('{tmp}')+'\background.bmp';
WizardForm.Position:=poScreenCenter;
MainForm.BORDERSTYLE:=bsNone;
width:=GetSystemMetrics(0);
height:=GetSystemMetrics(1);
MainForm.Width:=width;
MainForm.Height:=height;
width:=MainForm.ClientWidth;
height:=MainForm.ClientHeight;
MainForm.Left := 0;
MainForm.Top := 0;
BackgroundBitmapImage := TBitmapImage.Create(MainForm);
BackgroundBitmapImage.Bitmap.LoadFromFile(s);
BackgroundBitmapImage.Align := alClient;
BackgroundBitmapImage.Parent := MainForm;
BackgroundBitmapImage.Stretch:=True;
MainForm.Visible:=True;
end;

procedure DeInitializeSetup();
begin
BASS_Stop(); //нужно для остановки проигрывания
BASS_Free(); //нужно для быстрой выгрузки библиотеки вместе с муз. файлом
end;
[/more]
Автор: Cross45
Дата сообщения: 27.02.2009 09:20
Такая проблема: если делать несколько типов установки (полный, выборочный), как ему указать вес первого компонента, вес второго и т.д.?
Автор: nOobCrafter
Дата сообщения: 27.02.2009 13:15
уф, как то занимался инно но давно это было. Сейчас по нужде опять сталкиваюсь, появились вопросы, можно ли пользоваться масками когда пробегаемся по файлам в папке?..типа найти и скопировать все файлы *.exe \ *.dll?
Чего там много спрашиваю собсна, есть функция:

Код: procedure BackupDir(const FromDir,ToDir,FileMask:string;IsRemove,IncludeSubDirs:boolean);
var
FindRec:TFindRec;
sFileName,fd,td:string;
begin
fd:=AddBackslash(FromDir);
td:=AddBackslash(ToDir);
ForceDirectories(td);
if FindFirst(fd+FileMask,FindRec) then begin
try
repeat
sFileName:=fd+FindRec.Name;
if ((FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY)=0) then CopyFile_(sFileName,td,IsRemove)
else
if IncludeSubDirs then
if (FindRec.Name<>'') and (FindRec.Name<>'.') and (FindRec.Name<>'..') then
BackupDir(sFileName,td+FindRec.Name,FileMask,IsRemove,IncludeSubDirs);
until not FindNext(FindRec);
finally
FindClose(FindRec);
end;
end;
end;
Автор: hackerandrey
Дата сообщения: 27.02.2009 16:37
А можете пожалуйсто дать скрипт Сис требованией, и проверки их?
Автор: skeptik_vdm
Дата сообщения: 27.02.2009 19:05
hackerandrey
Смотри в шапке форума там все есть это Corona Skin & Check System Requirements от Victor_Dobrov и Коллекция скриптов (в этом архивчике есть скрипт называется Ultimate Test)!!!

Добавлено:
hackerandrey

В шапке форума есть Corona Skin в нем реализована проверка системных требований и еще в Коллекции скриптов там имеется скрипт Ultimate Test!!!
Автор: hackerandrey
Дата сообщения: 27.02.2009 19:43
Можете пожалуйсто соеденить это:
[more]
function GetSystemMetrics(nIndex:Integer):Integer;
external 'GetSystemMetrics@user32.dll stdcall';
function sndPlaySound(lpszSoundName: string; uFlags: cardinal):integer;
external 'sndPlaySoundA@winmm.dll stdcall';

procedure InitializeWizard();
var
width,height: Integer;
BackgroundBitmapImage: TBitmapImage;
s: string;
begin
//Выносим кнопку "Отмена" на передний план
WizardForm.CancelButton.BringToFront;
ExtractTemporaryFile('nyn.bmp');
s:=ExpandConstant('{tmp}')+'\nyn.bmp';
WizardForm.Position:=poScreenCenter;
MainForm.BORDERSTYLE:=bsNone;
width:=GetSystemMetrics(0);
height:=GetSystemMetrics(1);
MainForm.Width:=width;
MainForm.Height:=height;
width:=MainForm.ClientWidth;
height:=MainForm.ClientHeight;
MainForm.Left := 0;
MainForm.Top := 0;
BackgroundBitmapImage := TBitmapImage.Create(MainForm);
BackgroundBitmapImage.Bitmap.LoadFromFile(s);
BackgroundBitmapImage.Align := alClient;
BackgroundBitmapImage.Parent := MainForm;
BackgroundBitmapImage.Stretch:=True;
MainForm.Visible:=True;
ExtractTemporaryFile(ExpandConstant('Music.wav')); //Извлекаем звуковой файл во временную папку
sndPlaySound(ExpandConstant('{tmp}\Music.wav'), $0001 or $0008); //Проигрываем файл. Здесь указаны параметры для повторного проигрывания. Если мы хотим проиграть файл единожды, удаляем параметр 'or $0008'
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID=wpInstalling
then
begin
WizardForm.MainPanel.Visible:=False;
WizardForm.Bevel1.Visible:=False;
WizardForm.Width:=ScaleX(395);
WizardForm.Height:=ScaleY(142);
//Здесь смещение страницы установки (в верхний левый угол)
WizardForm.Left:=ScaleX(MainForm.Width-420);
WizardForm.Top:=ScaleY(MainForm.Height-170);
WizardForm.InnerNotebook.Left:=ScaleX(10);
WizardForm.InnerNotebook.Top:=ScaleY(10);
WizardForm.InnerNotebook.Width:=ScaleX(370);
WizardForm.StatusLabel.Left:=ScaleX(0);
WizardForm.StatusLabel.Top:=ScaleY(0);
WizardForm.StatusLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.FileNameLabel.Left:=ScaleX(0);
WizardForm.FileNameLabel.Top:=ScaleY(20);
WizardForm.FileNameLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.ProgressGauge.Top:=ScaleY(40);
WizardForm.ProgressGauge.Width:=WizardForm.InnerNotebook.Width;
WizardForm.CancelButton.Left:=ScaleX(154);
WizardForm.CancelButton.Top:=ScaleY(80);
end
if CurPageID=wpFinished
then
begin
WizardForm.Width:=502;{Размер окна по горизонтали}
WizardForm.Height:=392;{Размер окна по вертикали}
WizardForm.Position:=poScreenCenter; {Возврат в исходное состояние}
end
end;
function CheckSerial(Serial: String): Boolean;
begin
If (Serial='007KH-ABBAA-FOPHL-BNIHK-JLECN') or
(Serial='008KH-ABBAA-FOPSV-STYSU-OJUHH') or
(Serial='009KH-ABBAA-FOPCV-NCGCW-FEKQA') then
Result:=True
else
begin
Result:=False;
end;
end;
[/more]

С этим:

[more]
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;
oneMB = 1024*1024;
NeedMHz = 1800;
NeedVideoRAM = 128;
NeedSoundCard = 'Creative X-Fi';
NeedMB = 1024;
NeedPageFile = 1024;

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;
n, 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 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;

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 := clBlack
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $CCFFCC

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('Vista', SystemVersionPanel.Text) = 0) then // Windows Vista (c любым SP или без него)
begin
SystemVersionPanel.Color := $CCCCFF
ChangeText := True
end

// Процессор:
ProcessorMHzPanel.Color := $CCFFCC

if not CheckCPU(NeedMHz) then
begin
ProcessorMHzPanel.Color := $CCCCFF
ChangeText := True
end

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

// Видеокарта:
VideoRAMPanel.Color := $CCFFCC

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 := $CCCCFF
ChangeText := True
end
if (DeviceValue/oneMB < NeedVideoRAM) then
begin
VideoRAMPanel.Color := $CCCCFF
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 := $CCFFCC

// 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 := $CCCCFF
ChangeText := True
end
else
AudioNamePanel.Text := Keys[0]
if Pos(NeedSoundCard, AudioNamePanel.Text) = 0 then
AudioNamePanel.Text := AudioNamePanel.Text + ' (рекомендуется ' + NeedSoundCard + ')'

// Объём памяти:
RAMTotalPanel.Color := $CCFFCC
if not CheckMemorySize(NeedMB) then
begin
RAMTotalPanel.Color := $CCCCFF
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 := $CCFFCC
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 := $CCCCFF
ChangeText := True
end

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

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

procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = InfoPage.ID then UpdateInfo() // Обновление информации о системе
end;
[/more]

Ато я неумею
Автор: SotM
Дата сообщения: 27.02.2009 21:47
hackerandrey
Для начала узнай для чего существует тэг [no][more] [/more][/no], а затем отредактируй свое же сообщение.
Автор: hackerandrey
Дата сообщения: 27.02.2009 21:50
Я незнал об этом, теперь другое дело Так помогите плиз
Автор: Unc1e
Дата сообщения: 28.02.2009 11:32
hackerandrey, [more][no][code][/no]
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;
oneMB = 1024*1024;
NeedMHz = 1800;
NeedVideoRAM = 128;
NeedSoundCard = 'Creative X-Fi';
NeedMB = 1024;
NeedPageFile = 1024;

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;
n, 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';

function sndPlaySound(lpszSoundName: string; uFlags: cardinal):integer;
external 'sndPlaySoundA@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 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;

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 := clBlack
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $EEEEEE
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 := $CCFFCC

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('Vista', SystemVersionPanel.Text) = 0) then // Windows Vista (c любым SP или без него)
begin
SystemVersionPanel.Color := $CCCCFF
ChangeText := True
end

// Процессор:
ProcessorMHzPanel.Color := $CCFFCC

if not CheckCPU(NeedMHz) then
begin
ProcessorMHzPanel.Color := $CCCCFF
ChangeText := True
end

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

// Видеокарта:
VideoRAMPanel.Color := $CCFFCC

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 := $CCCCFF
ChangeText := True
end
if (DeviceValue/oneMB < NeedVideoRAM) then
begin
VideoRAMPanel.Color := $CCCCFF
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 := $CCFFCC

// 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 := $CCCCFF
ChangeText := True
end
else
AudioNamePanel.Text := Keys[0]
if Pos(NeedSoundCard, AudioNamePanel.Text) = 0 then
AudioNamePanel.Text := AudioNamePanel.Text + ' (рекомендуется ' + NeedSoundCard + ')'

// Объём памяти:
RAMTotalPanel.Color := $CCFFCC
if not CheckMemorySize(NeedMB) then
begin
RAMTotalPanel.Color := $CCCCFF
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 := $CCFFCC
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 := $CCCCFF
ChangeText := True
end

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

procedure InitializeWizard();
var
width,height: Integer;
BackgroundBitmapImage: TBitmapImage;
s: string;
begin
//Выносим кнопку "Отмена" на передний план
WizardForm.CancelButton.BringToFront;
ExtractTemporaryFile('nyn.bmp');
s:=ExpandConstant('{tmp}')+'\nyn.bmp';
WizardForm.Position:=poScreenCenter;
MainForm.BORDERSTYLE:=bsNone;
width:=GetSystemMetrics(0);
height:=GetSystemMetrics(1);
MainForm.Width:=width;
MainForm.Height:=height;
width:=MainForm.ClientWidth;
height:=MainForm.ClientHeight;
MainForm.Left := 0;
MainForm.Top := 0;

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

BackgroundBitmapImage := TBitmapImage.Create(MainForm);
BackgroundBitmapImage.Bitmap.LoadFromFile(s);
BackgroundBitmapImage.Align := alClient;
BackgroundBitmapImage.Parent := MainForm;
BackgroundBitmapImage.Stretch:=True;
MainForm.Visible:=True;
ExtractTemporaryFile(ExpandConstant('Music.wav')); //Извлекаем звуковой файл во временную папку
sndPlaySound(ExpandConstant('{tmp}\Music.wav'), $0001 or $0008); //Проигрываем файл. Здесь указаны параметры для повторного проигрывания. Если мы хотим проиграть файл единожды, удаляем параметр 'or $0008'
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = InfoPage.ID then begin UpdateInfo() end // Обновление информации о системе
if CurPageID=wpInstalling
then
begin
WizardForm.MainPanel.Visible:=False;
WizardForm.Bevel1.Visible:=False;
WizardForm.Width:=ScaleX(395);
WizardForm.Height:=ScaleY(142);
//Здесь смещение страницы установки (в верхний левый угол)
WizardForm.Left:=ScaleX(MainForm.Width-420);
WizardForm.Top:=ScaleY(MainForm.Height-170);
WizardForm.InnerNotebook.Left:=ScaleX(10);
WizardForm.InnerNotebook.Top:=ScaleY(10);
WizardForm.InnerNotebook.Width:=ScaleX(370);
WizardForm.StatusLabel.Left:=ScaleX(0);
WizardForm.StatusLabel.Top:=ScaleY(0);
WizardForm.StatusLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.FileNameLabel.Left:=ScaleX(0);
WizardForm.FileNameLabel.Top:=ScaleY(20);
WizardForm.FileNameLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.ProgressGauge.Top:=ScaleY(40);
WizardForm.ProgressGauge.Width:=WizardForm.InnerNotebook.Width;
WizardForm.CancelButton.Left:=ScaleX(154);
WizardForm.CancelButton.Top:=ScaleY(80);
end
if CurPageID=wpFinished
then
begin
WizardForm.Width:=502;{Размер окна по горизонтали}
WizardForm.Height:=392;{Размер окна по вертикали}
WizardForm.Position:=poScreenCenter; {Возврат в исходное состояние}
end
end;
function CheckSerial(Serial: String): Boolean;
begin
If (Serial='007KH-ABBAA-FOPHL-BNIHK-JLECN') or
(Serial='008KH-ABBAA-FOPSV-STYSU-OJUHH') or
(Serial='009KH-ABBAA-FOPCV-NCGCW-FEKQA') then
Result:=True
else
begin
Result:=False;
end;
end;[/more]
Автор: hackerandrey
Дата сообщения: 28.02.2009 11:39
Спасибо огромное! А можете расказать как обьеденять, или ссылку на урок чтобы я не просил часто обьеденить?
Автор: Unc1e
Дата сообщения: 28.02.2009 13:07
hackerandrey, если коротко, то объединение заключается в сложении повторяющихся процедур (функций). Например, в ваших 2-х скриптах повторяются процедуры InitializeWizard и CurPageChanged. Взяв за основной один из скриптов, добавляем в него то составляющее второго скрипта, которое в нем (в основном) не повторяется. А содержимое повторных процедур (функций), заключенное между первым begin и последним end данной процедуры (функции) второго скрипта поместить между первым begin и последним end соответствующей процедуры (функции) основного скрипта. Объявление глобальных var и const, а также вызов сторонних функций из dll лучше поместить в самое начало секции Code.
PS: эх и завернул...
PSS: если что не так - поправьте
Автор: hackerandrey
Дата сообщения: 28.02.2009 13:38
O_o это чтото страшное ты рассказал
Автор: Artem_Butenko
Дата сообщения: 01.03.2009 03:32
Вопрос специалистам, можно ли в Inno Setup реализовать такой алгоритм: инсталлятор извлекает путь установки из ключа системного реестра -> определяет размер и md5 некоторого файла в каталоге назначения -> копирует в данный каталог определенные файлы. Если md5 и размер файла отличен от заданного в первом случае, инсталлятор производит повторный анализ, и при совпадении вторичных условий, в папку назначения будут скопированы другие файлы. Если коротко, то при одном значении md5 и размера исходного файла (в каталоге назначения) должна быть скопирована одна группа файлов, а при другом значении md5 и размера того же файла (с тем же именем), другая группа файлов. Пожалуйста помогите, очень надо. Буду Вам бескрайне благодарен!

Страницы: 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071

Предыдущая тема: в очередной раз босудим антивиры?


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