CodeNet / Платформы / Windows / Windows API
Системная информация о компьютере
3 сентября 2006 года
1. Введение.
В статье рассматриваются способы получения системной информации о компьютере (операционная система, статус памяти, процессор и др.) Большинство примеров опирается на Windows API. Робота их подразумевается только под WIN32 (лишь отдельные функции работают под WIN32s). Статья направлена на аудиторию программистов Delphi, но может быть полезна программистам и других сред разработки приложений, интересующимся API и системной информацией. В статье использованы документы сайта http://apiwallst.ru/ , а также коды:
- SysInfo Component, Angel's;
- TSysInfo Component, RicoSoft;
- TSYSINFO 2.1, Brent Boswell.
Главы о памяти и процессах ранее мной публиковались в интернете. Здесь они представлены с незначительными изменениями. Остальные главы публикуются впервые.
2. Состояние памяти.
Для получения детальной информации о состоянии памяти компьютера предназначена функция API GlobalMemoryStatus. В функцию передается переменная типа TMemoryStatus, которая представляет собой запись, тип которой определен следующим образом:
type
TMemoryStatus = record
dwLength: DWORD;
dwMemoryLoad: DWORD;
dwTotalPhys: DWORD;
dwAvailPhys: DWORD;
dwTotalPageFile: DWORD;
dwAvailPageFile: DWORD;
dwTotalVirtual: DWORD;
dwAvailVirtual: DWORD;
end;
Поля записи имеют следующий смысл:
| dwLength | Длина записи. Поле необходимо инициализировать функцией SizeOf до обращения к функции GlobalMemoryStatus. |
| dwMemoryLoad | Количество использованной памяти в процентах. |
| dwTotalPhys | Число байт установленной на компьютере ОЗУ (физической памяти). |
| dwAvailPhys | Свободная физическая память в байтах. |
| dwTotalPageFile | Общий объем в байтах, который могут сохранить файлы/файл подкачки (вообще говоря, не совпадает с размером последних). |
| dwAvailPageFile | Доступный объем из последней величины в байтах. |
| dwTotalVirtual | Общее число байтов виртуальной памяти, используемой в вызывающем процессе. |
| dwAvailVirtual | Объем виртуальной памяти, доступной для вызывающего процесса. |
Можно использовать следующий код получения информации о наличной памяти ОЗУ:
function GetRAM: Cardinal;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwTotalPhys;
end;
Пользовательская функция GetRAM возвращает общее число байт физической памяти, установленной на компьютере. Эту информацию она читает из поля dwTotalPhys записи MS, имеющей тип TMemoryStatus. Перед этим вызывается API-функция GlobalMemoryStatus с параметром MS. Обратите внимание, что перед вызовом GlobalMemoryStatus инициализируется поле dwLength функцией SizeOf.
По аналогии с примером можно получить информацию об остальных параметрах памяти, для этого надо заменить строку Result:=MS.dwTotalPhys на одну из перечисленных ниже:
Result:=MS.dwMemoryLoad; Result:=MS.dwAvailPhys; Result:=MS.dwTotalPageFile; Result:=MS.dwAvailPageFile; Result:=MS.dwTotalVirtual; Result:=MS.dwAvailVirtual;
3. Информация о процессоре.
Функция GetSystemInfo с единственным параметром типа записи TSystemInfo дает доступ к различной системной информации. В частности, уровень процессора можно узнать из поля записи TSystemInfo – wProcessorLevel. Соответствие значений поля и основных уровней процессора приведено в таблице:
| Значение поля wProcessorLevel | Уровень процессора |
|---|---|
| 3 | 80386 |
| 4 | 80486 |
| 5 | Pentium |
| 6 | Pentium Pro |
Следующая пользовательская функция определяет уровень процессора:
function GetProcessorLevel: String;
var SI: TSystemInfo;
begin
GetSystemInfo(SI);
Case SI.wProcessorLevel of
3: Result:='80386';
4: Result:='80486';
5: Result:='Pentium';
6: Result:='Pentium Pro'
else Result:=IntToStr(SI.wProcessorLevel);end;
end;
Тактовую частоту процессора можно вычислить на основе следующего кода, использующего Ассемблер. Я его заимствовал, он хорошо работает, деталей реализации не знаю - привожу его без комментариев:
function GetCPUSpeed: Double;
const DelayTime = 500;
var TimerHi : DWORD;
TimerLo : DWORD;
PriorityClass : Integer;
Priority : Integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
DW 310Fh // rdtsc
MOV TimerLo, EAX
MOV TimerHi, EDX
end;
Sleep(DelayTime);
asm
DW 310Fh // rdtsc
SUB EAX, TimerLo
SBB EDX, TimerHi
MOV TimerLo, EAX
MOV TimerHi, EDX
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
end;
Данная пользовательская функция возвращает тактовую частоту процессора.
4. Информация о дисках.
Функция GetDriveType возвращает значение, по которому можно определить тип диска. Аргумент функции – буква, связанная с диском. Возвращаемые функцией значения и их смысл приведены в таблице:
| Возвращаемое значение | Смысл |
|---|---|
| 0 | Неизвестный |
| 1 | Не существует |
| Drive_Removable | Съемный |
| Drive_Fixed | Постоянный |
| Drive_Remote | Внешний |
| Drive_CDROM | Привод CD |
| Drive_RamDisk | Диск RAM |
Следующая пользовательская функция иллюстрирует использование функции GetDriveType. По букве диска она определяет тип диска и возвращает последний в строку:
function GetDrive(Drive: String): String;
var
DriveType : uInt;
begin
DriveType := GetDriveType(PChar(Drive));
case DriveType of
0: Result := '?';
1: Result := 'Path does not exists';
Drive_Removable: Result := 'Removable';
Drive_Fixed: Result := 'Fixed';
Drive_Remote: Result := 'Remote';
Drive_CDROM: Result := 'CD-ROM';
Drive_RamDisk: Result := 'RAMDisk'
else Result := 'Unknown';
end;
end;
Для определения размера диска служит функция DiskSize. Параметр, который в нее передается – номер диска (0 – текущий, далее по порядку: 1 – A, 2 – B и т.д.). Для получения размера в Мегабайтах можно использовать следующую пользовательскую функцию:
function GetDriveSize(Num: Byte): String;
begin
if DiskSize(Num) -1 then
Result := format('%d MB', [Trunc(DiskSize(Num)/1024/1024)])
else
Result := '';
end;
При ошибке ответ – пустая строка.
5. Операционная система.
Информация об операционной системе хранится в записи типа TOSVersionInfo, выглядещей следующим образом:
type TOSVersionInfo = record dwOSVersionInfoSize: DWORD; dwMajorVersion: DWORD; dwMinorVersion: DWORD; dwBuildNumber: DWORD; dwPlatformId: DWORD; szCSDVersion: array [0..126] of AnsiChar; end;
Поля записи имеют следующий смысл:
| dwOSVersionInfoSize | Размер записи. |
| dwMajorVersion | Старший номер версии ОС. |
| dwMinorVersion | Младший номер версии ОС. |
| dwBuildNumber | Номер сборки ОС (в нижнем слове поля). |
| dwPlatformId | Платформа. |
| szCSDVersion | Строка поддержки для использования PSS. Содержит дополнительную информацию об ОС. Чаще всего – это пустая строка. |
Поле dwPlatformId может иметь следующие значения:
| Ver_Platform_Win32s | Win32s в Windows 3.1 |
| Ver_Platform_Windows | Win32 в Windows 95 |
| Ver_Platform_Win32_NT | Windows NT |
Получить информацию об ОС позволяет API-функция GetVersionEx с единственным параметром типа TOSVersionInfo. Приведу пример ее использования:
function GetOS(var MajVer:Byte; var MinVer:Byte; var BuildNo:Word):String;
var VI: TOSVersionInfo;
begin
VI.dwOSVersionInfoSize:=SizeOf(VI);
GetVersionEx(VI);
MajVer:= VI.dwMajorVersion;
MinVer:= VI.dwMinorVersion;
BuildNo:= LoWord(VI.dwBuildNumber);
Result:= 'OS Version '+
IntToStr(MajVer)+'.'+
IntToStr(MinVer)+' build No '+
IntToStr(BuildNo);
end;
Пользовательская функция GetOS выводит строку с номером версии ОС. Обратите внимание, что перед вызовом GetVersionEx инициализируется поле dwOSVersionInfoSize функцией SizeOf.
Другой вариант реализации пользовательской функции получения информации о версии ОС может быть, например, таким (здесь используется дополнительная информация о системе из поля szCSDVersion):
function GetOS_2: string;
var
OSVersion: TOSVersionInfo;
begin
OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion);
if GetVersionEx(OSVersion) then
Result:= Format('%d.%d (%d.%s)',
[OSVersion.dwMajorVersion, OSVersion.dwMinorVersion,
(OSVersion.dwBuildNumber and $FFFF), OSVersion.szCSDVersion]);
end;
Следующая пользовательская функция выводит версию платформы:
function GetPlatform: String;
var VI: TOSVersionInfo;
begin
VI.dwOSVersionInfoSize:=SizeOf(VI);
GetVersionEx(VI);
Case VI.dwPlatformId of
Ver_Platform_Win32s: Result:= 'Win32s';
Ver_Platform_Win32_Windows: Result:='Win95';
Ver_Platform_Win32_NT: Result:='WinNT'
else Result:='Unknown Platform'; end;
end;
6. Информация об основных каталогах.
Три функции дают пути к трем основным каталогам: GetWindowsDirectory – к каталогу ОС, GetSystemDirectory – к системной папке ОС и GetCurrentDirectory – к текущей папке. Эти функции имеют два параметра – путь к папке и размер его представления в памяти.
Следующая пользовательская функция иллюстрируют применение функции GetWindowsDirectory для получения пути к каталогу Windows:
function GetWindowsDir: string; var S: array[0..MAX_PATH] of Char; begin GetWindowsDirectory(S,SizeOf(S)); Result:=S; end;
Для получения пути к системной папке в вышеприведенном примере вместо строки GetWindowsDirectory(S,SizeOf(S)) надо использовать GetSystemDirectory(S,SizeOf(S)), а для получения пути к текущему каталогу - GetCurrentDirectory(SizeOf(S),S). Комментарии тут, думаю, излишни. Замечу только, что в обращении к функции GetCurrentDirectory первым параметром стоит размер пути, в отличие от двух других функций, где он на втором месте.
7. Информация о пользователе и компьютере.
Имя компьютера позволяет получить функция GetComputerName. В нее передается два параметра – параметр типа PChar, в который записывается имя компьютера и второй параметр, определяющий длину записи под имя. Следующая пользовательская функция выводит имя компьютера в строку:
function GetCompName: String; var i: DWORD; p: PChar; begin i:=255; GetMem(p, i); GetComputerName(p, i); Result:=String(p); FreeMem(p); end;
Очень похожим способом получается имя пользователя из функции GetUserName:
function GetUser: String;
var
UserName : PChar;
NameSize : DWORD;
begin
UserName := #0;
NameSize := 50;
try
GetMem(UserName, NameSize);
GetUserName(UserName, NameSize);
Result:= StrPas(UserName);
finally
FreeMem(UserName);
end;
end;
Используя регистр, можно получить информацию о зарегистрированном владельце и зарегистрированном компьютере ОС (пользовательская функция GetPlatform описана ранее):
function GetRegInfo(var RegOwner: String; var RegOrg: String): Integer;
const
WIN95_KEY = '\SOFTWARE\Microsoft\Windows\CurrentVersion';
WINNT_KEY = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion';
var
VersionKey : PChar;
begin
Result:=0;
If GetPlatform = 'Win95' then VersionKey := WIN95_KEY else
If GetPlatform = 'WinNT' then VersionKey := WINNT_KEY else
begin Result:=-1; exit; end;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey(VersionKey, False) then
begin
RegOwner:= ReadString('RegisteredOwner');
RegOrg:= ReadString('RegisteredOrganization');
end;
finally
Free;
end;
end;
8. Процессы, выполняемые на компьютере.
Получить информацию о выполняющихся в данный момент на компьютере процессах можно на основе функций API. Для разных платформ эти функции отличаются, как и подключаемые для этих целей модули. Рассмотрим платформу Win95 и WinNT.
В Win95 (Windows 95/98) код может выглядеть следующим образом:
function GetProcessesWin95(var Proc: TProcArray):Integer;
var
FSnap: THandle;
PE: TProcessEntry32;
PPE: PProcessEntry32;
I: Integer;
begin
If FSnap > 0 then CloseHandle(FSnap);
FSnap:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
PE.dwSize:=SizeOf(PE);
I:=0;
SetLength(Proc, $3FFF-1); // заведомо большой массив
If Process32First(FSnap,PE) then
repeat
New(PPE);
PPE^:=PE;
Proc[I]:=PPE.szExeFile;
I:=I+1;
until not Process32Next(FSnap, PE);
Result:=I;
If FSnap > 0 then CloseHandle(FSnap); // очищаем память
end;
Для работы этого кода нужно подключить в разделе USES модуль TlHelp32 (Help Tool API 32).
Функция возвращает число процессов и записывает их пути в массив-переменную Proc. Тип переменной Proc – обычный массив строк, который нужно описать в разделе описания типов:
type TProcArray = Array of String;
Строка FSnap:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0) означает получение «моментального снимка всех процессов». Точнее, в результате ее выполнения мы получаем дескриптор снимка. Функции Process32First и Process32Next позволяют «пробежаться» по всем процессам.
Для NT-платформы (Windows NT/2000) аналогичный код может выглядеть следующим образом (здесь уже используется модуль PSAPI, который необходимо включить в раздел USES):
function GetProcessesWinNT(var Proc: TProcArray):Integer;
var
Num: Integer;
LP: Array[0..$3FFF-1] of Dword; // заведомо большой массив
CB: DWord;
CBNeeded:DWord;
ProcHndl: THandle;
ModHand: HModule;
ModName: array [0..MAX_PATH] of Char;
I: Integer;
begin
EnumProcesses(@LP,CB,CBNeeded);
Num:= CBNeeded div SizeOf(DWORD);
SetLength(Proc,Num);
For I:=0 to Num-1 do
begin
ProcHndl:=
OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,LP[I]);
If GetModuleFileNameEx(ProcHndl,ModHand,ModName,SizeOf(ModName))> 0 then
Proc[I]:=ModName else Proc[I]:='Unknown';
end;
IF ProcHndl > 0 then CloseHandle(ProcHndl);
Result:=Num;
end;
9. Дисплей и клавиатура.
Краткую информацию о дисплеи можно поучить с помощью следующего кода, базирующегося на функции EnumDisplayDevices и структуре типа TDisplayDevice:
function GetVideoCard: String;
var
lpDisplayDevice: TDisplayDevice;
dwFlags: DWORD;
cc: DWORD;
begin
lpDisplayDevice.cb := sizeof(lpDisplayDevice);
dwFlags := 0;
cc:= 0;
while EnumDisplayDevices(nil, cc, lpDisplayDevice , dwFlags) do
begin
Inc(cc);
Result:=lpDisplayDevice.DeviceName;
end;
end;
Раскладку клавиатуры можно получить, используя следующую пользовательскую функцию:
function GetKeyBoardLanguage: String; var ID:LangID; Language: array [0..100] of Char; begin ID:=GetSystemDefaultLangID; VerLanguageName(ID,Language,100); Result:=String(Language); end;
Здесь всю работу делает функция VerLanguageName, работающая в связке с функцией GetSystemDefaultLangID.
10. Заключение.
В статье были рассмотрены способы получения основной информации о компьютере. Реализацию примеров на Delphi6 можно найти в моем модуле SysInfo v.3 на моем сайте http://sadovoya.narod.ru . Там можно найти и динамическую библиотеку, правда, с несколько урезанным набором функций. Она может быть полезна программистам других сред разработки.
Оставить комментарий
Комментарии
Написал бортовой самописец, каждый час записывает информацию о системе.
Только вот вопрос: Почему Частоту (Hz) процессора ассм-код получает каким-то очень хитрым способом, ведь на выходе получается дробь, да еще и не стабильная.
А так спасибо!
Автор.
Чтобы OpenProcess() работал более успешно, надо вызывающей программе повысить привилегии до уровня SeDebugPrivilege (константа SE_DEBUG_NAME). Это дает доступ к процессам вплоть до PROCESS_ALL_ACCESS. Без этого OpenProcess() может не получить \"хэндла\" с запрошенными флагами доступа.
Делается это примерно так. Вставляем до цикла \"For I:=0 to Num-1 do...\" следующий код:
OpenThreadToken(
GetCurrentThread(), //наша программы
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
FALSE,
@hToken
);
tp.PrivilegeCount:=0;
tp.Privileges[0].Attributes:=0;
tp.Privileges[0].Luid:=0;
cbT:= sizeof(TOKEN_PRIVILEGES);
LookupPrivilegeValue( 0, SE_DEBUG_NAME, @luidMod );
tp.PrivilegeCount:= 1;
tp.Privileges[0].Luid:= luidMod;
tp.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges( hToken, false, @tp, cbT, 0, 0 );
if (hToken <> 0) then CloseHandle(hToken); //больше не нужен
А в раздел var добавляем переменные:
hToken : Cardinal;
tp: TOKEN_PRIVILEGES;
luidMod: LUID;
Проверил этот метод в Lazarus. В uses подключил модуль Windows. В Delphi должно быть тоже самое. В списке процессов по-прежнему неопределенные процессы присутствуют, но их всего несколько - это системныее процессы самого высшего уровня. Увеличение до PROCESS_ALL_ACCESS флага в OpenProcess() ситуацию не улучшает.
Автор