Chanka
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Кто-нибудь помогите пожалуйста. Совсем запутался. Как в этот код добавить проверку операционной системы. И как добавить символ к дискам \. Т.е С: на C:\
[Setup]
AppName=SystemTest
AppVerName=SystemTest <Version>
CreateAppDir=false
[Files]
Source: get_hw_caps.dll; Flags: dontcopy
[Languages]
Name: russian; MessagesFile: compiler:Languages\Russian.isl
[Code]
const oneMB = 1024*1024; BufferLen = 50;
type TMemoryStatus = record dwLength, dwMemoryLoad, dwTotalPhys, dwAvailPhys, dwTotalPageFile, dwAvailPageFile, dwTotalVirtual, dwAvailVirtual: Longint; end;
var Memory: TMemoryStatus; FreeMB, TotalMB: Cardinal; VolumeSerialNo, MaxComponentLength, FileSystemFlags: Longint; i: Integer; VolumeName, FileSystemName: String; ListBox: TListBox;
ProcessorName: string;
Processor, VideoCardPanel, AudioCardPanel, RAMPanel, PageFilePanel: TMemo;
ProcessorNamePanel, VideoCardNamePanel, AudioCardNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;
ProcessorMHZ: Cardinal;
StaticText, StaticText2: TNewStaticText;
SysTestPage: TWizardPage;
Text: TNewStaticText;
Memo: TMemo;
procedure GlobalMemoryStatus(var lpBuffer: TMemoryStatus);
external 'GlobalMemoryStatus@kernel32.dll';
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 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 GetSystemMetrics(nIndex: Integer):Integer;
external 'GetSystemMetrics@user32.dll stdcall';
function GetVolumeInformation(PathName, VolumeName: PChar; VolumeNameSize, VolumeSerialNumber, MaxComponentLength, FileSystemFlags: Longint; FileSystemName: PChar; FileSystemNameSize: Longint): Longint;
external 'GetVolumeInformationA@kernel32.dll stdcall';
function DelSp(String: String): String; // Удаление начальных и конечных пробелов
begin while (Pos(' ', String) =1) do Delete(String,1,1) while (Copy(String, Length(String),1)=' ') do Delete(String,Length(String),1) Result:= String end;
function MorG(MB, onlyMB: Integer): String; // Значение в строку объёма Мб/Гб (Гб округлим до 3-ёх знаков после запятой)
begin if (MB < 1000) or (onlyMB > 0) then Result:= IntToStr(MB)+ 'Мб' else Result:= FloatToStr(round(MB/1024*1000)/1000)+ 'Гб' end;
procedure ListBoxOnClick(Sender: TObject);
begin for i:= 0 to ListBox.Items.Count-1 do if ListBox.Selected[i] then WizardForm.DirEdit.Text:= Copy(ListBox.Items[i],1,1) +Copy(WizardForm.DirEdit.Text, 2, Length(WizardForm.DirEdit.Text)); end;
procedure InitializeWizard();
begin
RegQueryStringValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', 'ProcessorNameString', ProcessorName);
RegQueryDWordValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', '~MHz', ProcessorMHZ);
GetVidMemLocal;
GetSoundCards;
GlobalMemoryStatus(Memory);
SysTestPage := CreateCustomPage(wpWelcome, 'Аппаратное обеспечение', 'Программа установки обнаружила следующие необходимые компоненты');
StaticText := TNewStaticText.Create(SysTestPage);
with StaticText do
begin
Parent := SysTestPage.Surface;
Caption := 'Все компоненты соответствуют требованиям программы.';
StaticText.Font.Color:=clGreen;
Left := 0;
Top := 0;
AutoSize := True;
end;
StaticText2 := TNewStaticText.Create(SysTestPage);
with StaticText2 do
begin
Parent := SysTestPage.Surface;
Caption := 'Когда Вы будете готовы продолжить установку, нажмите «Далее».';
Left := 0;
Top := 220;
AutoSize := True;
end;
//******************************************* [Начало - Процессор] ***************************************************//
Processor := TMemo.Create(SysTestPage);
with Processor do
begin
Text := ' Процессор';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(0);
Top := ScaleY(30);
Width := ScaleX(100);
Height := ScaleY(22);
ReadOnly := True;
Color := $EEEEEE;
end;
ProcessorNamePanel := TMemo.Create(SysTestPage);
with ProcessorNamePanel do
begin
Text := ' ' + DelSp(ProcessorName) + ' ~' + IntToStr(ProcessorMHZ) + ' MHz';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(104);
Top := ScaleY(30);
Width := ScaleX(313);
Height := ScaleY(22);
ReadOnly := True;
Color := $CCFFCC;
end;
//******************************************* [Конец - Процессор] ****************************************************//
//******************************************* [Начало - Видеоадаптер] ************************************************//
VideoCardPanel := TMemo.Create(SysTestPage);
with VideoCardPanel do
begin
Text := ' Видеоадаптер';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(0);
Top := Processor.Top + 27;
Width := ScaleX(100);
Height := ScaleY(22);
ReadOnly := True;
Color := $EEEEEE;
end;
VideoCardNamePanel := TMemo.Create(SysTestPage);
with VideoCardNamePanel do
begin
Text := ' ' + DelSp(GetVideoCardName) + ', '+ MorG(round(GetVidMemLocal/oneMB/64)*64,1) + ', ' + IntToStr(GetSystemMetrics(0)) + 'x' +IntToStr(GetSystemMetrics(1));;
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(104);
Top := VideoCardPanel.Top;
Width := ScaleX(313);
Height := ScaleY(22);
ReadOnly := True;
Color := $CCFFCC;
end;
//******************************************* [Конец - Видеоадаптер] *************************************************//
//******************************************* [Начало - Звуковая карта] **********************************************//
AudioCardPanel := TMemo.Create(SysTestPage);
with AudioCardPanel do
begin
Text := ' Звуковая карта';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(0);
Top := VideoCardPanel.Top + 27;
Width := ScaleX(100);
Height := ScaleY(22);
ReadOnly := True;
Color := $EEEEEE;
end;
AudioCardNamePanel := TMemo.Create(SysTestPage);
with AudioCardNamePanel do
begin
Text := ' ' + DelSp(GetSoundCardName) + ' (рекомендуется Creative X-Fi)';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(104);
Top := AudioCardPanel.Top;
Width := ScaleX(313);
Height := ScaleY(22);
ReadOnly := True;
Color := $CCFFCC;
end;
//******************************************* [Конец - Звуковая карта] ***********************************************//
//******************************************* [Начало - ОЗУ] *********************************************************//
RAMPanel := TMemo.Create(SysTestPage);
with RAMPanel do
begin
Text := ' ОЗУ';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(0);
Top := AudioCardPanel.Top + 27;
Width := ScaleX(100);
Height := ScaleY(22);
ReadOnly := True;
Color := $EEEEEE;
end;
RAMTotalPanel := TMemo.Create(SysTestPage);
with RAMTotalPanel do
begin
Text := ' ' + MorG(round(Memory.dwTotalPhys/oneMB/64)*64,1) + ' всего, ' + MorG(Memory.dwAvailPhys/oneMB,1) +' свободно, ' + MorG((Memory.dwTotalPhys - Memory.dwAvailPhys)/oneMB,1) +' используется';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(104);
Top := RAMPanel.Top;
Width := ScaleX(313);
Height := ScaleY(22);
ReadOnly := True;
Color := $CCFFCC;
end;
//******************************************* [Конец - ОЗУ] **********************************************************//
//******************************************* [Начало - Файл подкачки] ***********************************************//
PageFilePanel := TMemo.Create(SysTestPage);
with PageFilePanel do
begin
Text := ' Файл подкачки';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(0);
Top := RAMPanel.Top + 27;
Width := ScaleX(100);
Height := ScaleY(22);
ReadOnly := True;
Color := $EEEEEE;
end;
PageFileTotalPanel := TMemo.Create(SysTestPage);
with PageFileTotalPanel do
begin
Text := ' '+MorG(GetSystemPage,1)+' всего, ' + MorG((Memory.dwTotalPageFile - Memory.dwAvailPageFile)/oneMB,0) + ' занято системным кэшем';
Alignment := taLeftJustify;
Parent := SysTestPage.Surface;
Left := ScaleX(104);
Top := PageFilePanel.Top;
Width := ScaleX(313);
Height := ScaleY(22);
ReadOnly := True;
Color := $CCFFCC;
end;
//******************************************* [Конец - Файл подкачки] ************************************************//
ListBox:= TListBox.Create(WizardForm)
with ListBox do begin
Color:= $EEEEEE; Font.Size:= 10; Font.Name:= 'Tahoma'; Font.Style:=[fsBold]; Parent:= WizardForm.SelectDirPage; OnClick:= @ListBoxOnClick; Top:= WizardForm.DirEdit.Top +WizardForm.DirEdit.Height +ScaleY(30); Width:= WizardForm.DirBrowseButton.Left + WizardForm.DirBrowseButton.Width - WizardForm.DirEdit.Left; Height:= WizardForm.DiskSpaceLabel.Top -Top -9;
FileSystemName:= StringOfChar(' ', BufferLen); VolumeName:= StringOfChar(' ', BufferLen);
for i:=0 to GetHardDrivesCount-1 do begin
GetSpaceOnDisk(GetHardDriveName(i), True, FreeMB, TotalMB); GetVolumeInformation(GetHardDriveName(i), VolumeName, BufferLen-1, VolumeSerialNo, MaxComponentLength, FileSystemFlags, FileSystemName, BufferLen-1);
Items.Add(Copy(Uppercase(GetHardDriveName(i)),0,2)+ Copy(' ',0,14-Length(MorG(TotalMB,0)))+ MorG(TotalMB,0)+ Copy(' всего, ',0,17-Length(MorG(FreeMB,0)))+ MorG(FreeMB,0)+ Copy(' (0',0,4-Length(IntToStr(round(FreeMB/TotalMB*100)))) + FloatToStr(round(FreeMB/TotalMB*100))+ '%) свободно, '+ FileSystemName); end;
end;
with TNewStaticText.Create(WizardForm) do begin Top:= WizardForm.DirEdit.Top +WizardForm.DirEdit.Height +ScaleY(8); Caption:='Список локальных дисков, присутствующих в системе:'; Parent:= WizardForm.SelectDirPage; end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = SysTestPage.ID then
if ProcessorMHZ < 3800 then //Минимальное значение частоты в MHz
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям программы.';
StaticText.Font.Color := clRed;
ProcessorNamePanel.Color := $CCCCFF;
WizardForm.NextButton.Enabled:=False
end;
if round(GetVidMemLocal/oneMB/64)*64 < 128 then //Минимальный объём ОЗУ видеоадаптера в Мб
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям программы.';
StaticText.Font.Color := clRed;
VideoCardNamePanel.Color := $CCCCFF;
WizardForm.NextButton.Enabled:=False
end;
if GetSoundCards = 0 then
begin
AudioCardNamePanel.Text:=' Устройство не обнаружено';
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям программы.';
StaticText.Font.Color := clRed;
AudioCardNamePanel.Color := $CCCCFF;
WizardForm.NextButton.Enabled:=False
end;
if round(Memory.dwTotalPhys/oneMB/64)*64 < 512 then //Минимальный объём ОЗУ в Мб
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям программы.';
StaticText.Font.Color := clRed;
RAMTotalPanel.Color := $CCCCFF;
WizardForm.NextButton.Enabled:=False
end;
if GetSystemPage < 768 then //Минимальный объём файла подкачки в Мб
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям программы.';
StaticText.Font.Color := clRed;
PageFileTotalPanel.Color := $CCCCFF;
WizardForm.NextButton.Enabled:=False
end;
end; |
. Выражаю тебе благодарность за отзывчивость и помощь моему проекту.
