• MaxUa
• Шпаргалка
• DELPHI INTERBASE FireBird
• Системная информация о компьютере

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

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. Соответствие значений поля и основных уровней процессора приведено в таблице:

Следующая пользовательская функция определяет уровень процессора:

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

Следующая пользовательская функция иллюстрирует использование функции 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;

Поля записи имеют следующий смысл:

Поле dwPlatformId может иметь следующие значения:

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

http://www.codenet.ru/progr/delphi/stat/System-Information.php