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

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

• Delphi 7 ToolsAPI
• Что такое порт, правила для работы с портами
• Программирование на основе Win32 API в Delphi