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