Логин: Пароль:    Регистрация Всеми возможностями сайта можно пользоваться
только после авторизации.
   Забыли пароль?

Поиск
L



Статистика
u
Пользователи онлайн: нет
Гостей онлайн: 2
Всего онлайн: 2
Зарегистрировано юзеров: 6362
Комментариев на сайте: 645
Новый юзер: Pseulairrerve



Последние комментарии
c
Aqel прокомментировал "Урок 71 - Работа с сжатыми файлами":
GZip псевдоархив, на мой вопрос тоже не отвечают, как распаковать отдельные файлы/папки...
Pingitrus прокомментировал "Урок 71 - Работа с сжатыми файлами":
Есть еще кто нибудь живой на этом сайте, кто сможет помочь? Так то все работает, zip и rar распаковывает, но у меня есть файл dat который сжат GZip, почему то его не удается распаковать или так не получится так как этот файл не является архивом или является?)) пишет ошибку что неверная функция



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

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

Источник: www.thedelphi.ru
Автор: Савельев Александр
Опубликовано: 27 Сентября 2014
Просмотров:


Зарегистрируйтесь или авторизуйтесь, чтобы добавлять комментарии.