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

Вот и всё, Удачи!