Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Курс видеоуроков программирования и крэкерства 6.0
(актуальность: февраль 2017)
Свежие инструменты, новые видеоуроки!

  • 300+ видеоуроков
  • 800 инструментов
  • 80 свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Delphi и системная информация о ресурсах компьютера

Компьютеры - вещь слишком сложная, чтобы работать в принципе. Поэтому то, что они работают хоть как-то, уже чудо.

Иногда Delphi-приложениям может не хватать функциональной полноты стандартной библиотеки компонентов и тогда бывает необходимо обратиться к Microsoft Win32 API (Application Programming Interface - интерфейса взаимодействия прикладной программы с операционной системой). Почти все функции из Microsoft Win32 API описаны в модуле windows.pas (который по умолчанию включается в cекцию uses новых модулей). Cледует заметить, что часть из этих функции ведет себя по разному в зависимости от текущей операционной системы (Windows 95, 98, NT).

Разработаем программу, показывающую нам некоторую системную информацию о компьютере. В частности, хотелось бы получить информацию о версии ОС, ее директориях, свойствах экрана, ресурсах памяти, имени пользователя и компьютера, дате BIOS. Помимо этого, разрешим пользователю изменять настройки клавиатуры, встроенного динамика и хранителя экрана.

Процесс визуального проектирования описывать не будем; рассмотрим лишь страницу «Параметры». Для удобства управления параметрами клавиатуры положим на нее две компоненты TTrackBar. Изменим свойство Name на tbKeyboardDelay и tbKeyboardSpeed. Изменим свойство PageSize на 1. Для tbKeyboardDelay установим Max=3 и для tbKeyboardSpeed. Max=31. Для управления свойствами хранителя экрана используем TCheckBox (свойство Name сменим на cbScreenSaverActive, Caption на &‘Хранитель экрана&’) и TMaskEdit (свойство Name=&’edSSTimeOut&’ и EditMask=&’!999;1;&’). Аналогично добавим TCheckBox (свойство Name=&’cbSpeaker&’, Caption=&’Использование встроенного динамика&’ ).

Рассмотрим текст программы. В список включаемых модулей uses добавим registry. Добавим описание процедур в раздел public описания TfmMain.


 type
 TfmMain = class(TForm)
 ...
 procedure FormCreate(Sender: TObject);
 procedure Change(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 KeyboardDelay,
 KeyboardSpeed,
 ScreenSaveTimeOut : integer;
 procedure ParametersInfo;
 procedure ShowSomeInfo;
 procedure BIOSInfo(OS : string);
 procedure HardwareInfo;
 procedure MemoryInfo;
 procedure VideoInfo;
 procedure OSInfo;
 end;
 
 var fmMain: TfmMain;
 
 implementation
 uses Registry;
 {$R *.DFM}
 

Сначала получим информацию о компьютере. Используем функцию GetComputerName для получения имени компьютера, функцию GetUserName для получения имени пользователя и функцию GetSystemInfo для получения информации о процессоре (наиболее полно данная функция реализована в Windows NT, где она возвращает и кол-во процессоров и их тип и т.д.).


 // Информация о компьютере.
 procedure TfmMain.HardwareInfo;
 var Size : cardinal;
 PRes : PChar;
 BRes : boolean;
 lpSystemInfo : TSystemInfo;
 begin
 // Имя компьютера
 Size := MAX_COMPUTERNAME_LENGTH + 1;
 PRes := StrAlloc(Size);
 BRes := GetComputerName(PRes, Size);
 if BRes then laCompName_.Caption := StrPas(PRes);
 // Имя пользователя
 Size := MAX_COMPUTERNAME_LENGTH + 1;
 PRes := StrAlloc(Size);
 BRes := GetUserName(PRes, Size);
 if BRes then laUserName_.Caption := StrPas(PRes);
 // Процессор
 GetSystemInfo(lpSystemInfo);
 laCPU_.Caption := 'класса x' + IntToStr
 (lpSystemInfo.dwProcessorType);
 end;
 

Перейдем к параметрам экрану. Здесь мы будем использовать и Win32 API функции и стандартные объекты VCL. Так для получения разрешения экрана нам понадобится объект TScreen (его свойства Width и Height). Остальные параметры мы получим через контекст драйвера устройства DC используя функцию GetDeviceCaps.


 // Информация о видеосистеме.
 procedure TfmMain.VideoInfo;
 var DC : hDC;
 c : string;
 begin
 // Разрешение экрана
 laWidth_.Caption := IntToStr(Screen.Height);
 laHeight_.Caption := IntToStr(Screen.Width);
 // Информация о глубине цвета.
 DC := CreateDC('DISPLAY',nil,nil,nil);
 laBitsPerPixel_.Caption :=
 IntToStr(GetDeviceCaps(DC,BITSPIXEL));
 laPlanes_.Caption :=
 IntToStr(GetDeviceCaps(DC,PLANES));
 case GetDeviceCaps(DC,BITSPIXEL) of
 8 : c := '256 цветов';
 15 : c := 'Hi-Color / 32768 цветов';
 16 : c := 'Hi-Color / 65536 цветов';
 24 : c := 'True-Color / 16 млн цветов';
 32 : c := 'True-Color / 32 бит';
 end;
 laColors_.Caption := c;
 DeleteDC(DC);
 end;
 

Также будет интересна информация о памяти. Здесь нам поможет функция GlobalMemoryStatus, возвращающая информацию по объему физической и виртуальной памяти.


 // Информация о памяти.
 procedure TfmMain.MemoryInfo;
 var lpMemoryStatus : TMemoryStatus;
 begin
 lpMemoryStatus.dwLength := SizeOf(lpMemoryStatus);
 GlobalMemoryStatus(lpMemoryStatus);
 with lpMemoryStatus do begin
 laFreeMemory.Caption :=
 laFreeMemory.Caption +
 IntToStr(dwMemoryLoad) + '%';
 laRAM_.Caption := Format('%0.0f Мбайт',
 [dwTotalPhys div 1024 / 1024]);
 laFreeRAM_.Caption := Format('%0.3f Мбайт',
 [dwAvailPhys div 1024 / 1024]);
 laPF_.Caption := Format('%0.0f Мбайт',
 [dwTotalPageFile div 1024 / 1024]);
 laPFFree_.Caption := Format('%0.0f Мбайт',
 [dwAvailPageFile div 1024 / 1024]);
 end;
 end;
 

Узнаем информацию о ОС. Функция GetWindowsDirectory вернет путь к каталогу, где установлена система, функция GetSystemDirectory - к системному каталогу. Для определения версии ОС воспользуемся функцией GetVersionEx.


 // Информация о Windows.
 procedure TfmMain.OSInfo;
 var PRes : PChar;
 Res : word;
 BRes : boolean;
 lpVersionInformation : TOSVersionInfo;
 c : string;
 begin
 // Каталог, где установлена Windows
 PRes := StrAlloc(255);
 Res := GetWindowsDirectory(PRes, 255);
 if Res > 0 then laWinDir_.Caption :=
 StrPas(PRes);
 // Системный каталог Windows
 Res := GetSystemDirectory(PRes, 255);
 if Res > 0 then laSysDir_.Caption :=
 StrPas(PRes);
 // Имя ОС
 lpVersionInformation.dwOSVersionInfoSize :=
 SizeOf(TOSVersionInfo);
 BRes := GetVersionEx(lpVersionInformation);
 if BRes then
 with lpVersionInformation do case dwPlatformId of
 VER_PLATFORM_WIN32_WINDOWS :
 if dwMinorVersion=0 then c := 'Windows 95'
 else c := 'Windows 98';
 VER_PLATFORM_WIN32_NT : c := 'Windows NT';
 VER_PLATFORM_WIN32s : c := 'Win 3.1 with Win32s'
 end;
 laVersion_.Caption := c;
 // Дата создания BIOS-а
 if c='Windows NT' then BIOSInfo('NT') else BIOSInfo('95');
 end;
 

В предыдущем отрывке программы внимательный читатель заметил вызов функции BIOSInfo с параметром, характеризующем текущую ОС. Опишем эту функцию. Важно отметить, что способ получения информации о дате BIOS различен. Для NT получим информацию из реестра, а для Windows 95/98 из соответствующего участка памяти. Эти два способа взаимоисключаемы, так как у Windows 95/98 нет соответствующего раздела реестра, а прямой доступ к памяти в NT невозможен.


 // Информация о дате создания BIOS-а.
 procedure TfmMain.BIOSInfo(OS : string);
 var p : pointer;
 s : string[255];
 begin
 if OS='NT' then begin with TRegistry.Create do
 try RootKey := HKEY_LOCAL_MACHINE;
 if OpenKeyReadOnly
 ('HARDWARE\DESCRIPTION\System')
 then laBIOSDate_.Caption :=
 ReadString('SystemBiosDate')
 finally Free;
 end;
 end
 else try
 s[0] := #8;
 p := Pointer($0FFFF5);
 Move(p^,s[1],8);
 laBIOSDate_.Caption :=
 copy(s,1,2) + '/' + copy(s,4,2) + '/' +copy (s,7,2);
 except laBIOSDate_.Caption := 'XX.XX.XXXX';
 end;
 end;
 

Рассмотрим функцию SystemParametersInfo, которая позволяет управлять некоторыми настройками системы. Область применения данной функции для NT и Windows 95/98 различна. Умышленно выберем некоторую общую часть для обеих систем.


 // Информация о параметрах
 procedure TfmMain.ParametersInfo;
 var Bl : boolean;
 begin
 // Разрешен ли PC Speaker
 SystemParametersInfo(SPI_GETBEEP,0,@Bl,0);
 cbSpeaker.Checked := Bl;
 // Активен ли хранитель экрана
 SystemParametersInfo
 (SPI_GETSCREENSAVEACTIVE,0,@Bl,0);
 cbScreenSaverActive.Checked := Bl;
 // Интервал вызова хранителя экрана
 SystemParametersInfo
 (SPI_GETSCREENSAVETIMEOUT,0,
 @ScreenSaveTimeOut,0);
 // Настройки клавиатуры
 SystemParametersInfo
 (SPI_GETKEYBOARDDELAY,0,
 @KeyboardDelay,0);
 SystemParametersInfo
 (SPI_GETKEYBOARDSPEED,0,
 @KeyboardSpeed,0);
 end;
 
 // Отображение настроек
 procedure TfmMain.ShowSomeInfo;
 begin
 tbKeyboardDelay.Position := 3 - KeyboardDelay;
 tbKeyboardSpeed.Position := KeyboardSpeed;
 edSStimeOut.EditMask := IntToStr
 (ScreenSaveTimeOut div 60);
 end;
 

Также позволим пользователю изменять и сохранять настройки системы по своему вкусу. Здесь также будем использовать функцию SystemParametersInfo. Для компонентов tbKeyboardSpeed, tbKeyboardDelay, cbScreenSaverActive, cbSpeaker, edSSTimeOut в ObjectInspector перейдем на закладку Events и изменим событие OnChange (для tbKeyboardSpeed, tbKeyboardDelay) , OnClick (для cbScreenSaverActive, cbSpeaker) и OnExit для edSSTimeOut на Change. Таким образом, все пять вышеперечисленных компонент после изменений состояний передадут управление нижеприведенной процедуре.


 // Сохранение изменений параметров системы
 procedure TfmMain.Change(Sender: TObject);
 var Sen : TComponent;
 begin
 Sen := Sender as TComponent;
 // Вкл/Выкл PC Speaker-а.
 if (Sen.Name='cbSpeaker') and cbSpeaker.Checked
 then SystemParametersInfo
 (SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE)
 else SystemParametersInfo
 (SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);
 // Вкл/Выкл активности хранителя экрана.
 if (Sen.Name='cbScreenSaver') and cbScreenSaverActive.Checked
 then SystemParametersInfo
 (SPI_SETSCREENSAVEACTIVE,1,nil,SPIF_UPDATEINIFILE)
 else SystemParametersInfo
 (SPI_SETSCREENSAVEACTIVE,0,nil,SPIF_UPDATEINIFILE);
 // Изменение значения задержки перед повтором с клавиатуры
 if (Sen.Name='tbKeyboardDelay') then SystemParametersInfo(
 SPI_SETKEYBOARDDELAY,3-tbKeyboardDelay.Position,nil,
 SPIF_SENDWININICHANGE);
 // Изменение значения скорости ввода с клавиатуры
 if (Sen.Name='tbKeyboardSpeed') then SystemParametersInfo(
 SPI_SETKEYBOARDSPEED,tbKeyboardSpeed.Position,nil,
 SPIF_SENDWININICHANGE);
 // Изменение интервала запуска хранителя экрана
 if (Sen.Name='edSSTimeOut') then SystemParametersInfo(
 SPI_SETSCREENSAVETIMEOUT,StrToInt(edSSTimeOut.Text)
 *60,nil,SPIF_UPDATEINIFILE);
 end;
 

И ,наконец, вызовем все эти процедуры при создании формы.


 // Вызов информационных процедур при создании формы.
 procedure TfmMain.FormCreate(Sender: TObject);
 begin
 HardwareInfo;
 MemoryInfo;
 VideoInfo;
 ParametersInfo;
 ShowSomeInfo;
 OSInfo;
 end;
 

Использование Delphi совместно c фунциями Microsoft Win32 API позволит программисту создать более функционально богатые и гибкие приложения.




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS