Системная информация о компьютере

© 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;

Можно использовать следующий код получения информации о наличной памяти ОЗУ:

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

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;

PSAPI

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

Copyright© 2006 Андрей Садовой  Специально для Delphi Plus

Пожалуйста, оцените статью

Отлично Хорошо Средне Плохо Очень плохо