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 ('HARDWAREDESCRIPTIONSystem') 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 позволит программисту создать более функционально богатые и гибкие приложения.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com