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