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

Садыков Марат Рифович
программист АКБ <Заречье>

Получить исходный код