Системная информация о компьютере
Автор: Садовой А.Г.
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 . Там можно найти и динамическую библиотеку, правда, с несколько урезанным набором функций. Она может быть полезна программистам других сред разработки.