Получить информацию о BIOSе

Материал из DRKB

Получить информацию о BIOSе[править | править код]

Вот пример как можно даты БИОС материнской платы и видеокарты выдрать. То же самое можно с названием производителя и версией. В WinNT приходится читать не из ПЗУ а из реестра но это достаточно надежно - соотв ключи WinNT закрывает на запись и обновляет при каждом старте (?). Для Win9x можешь хоть весь БИОС напрямую читать.

Получить заводской номер винчестера (не тот что getvolumeinfo дает) ИМХО невозможно - порты IDE даже Win9x блокирует.


type
  TRegistryRO = class(TRegistry)
   function OpenKeyRO(const Key: string): Boolean;
  end;
{ это уже ветхая история - был один глюк у D3 }

implementation

uses
  WAPIInfo, Windows, SysUtils, StrUtils;

function TRegistryRO.OpenKeyRO(const Key: string): Boolean;
  function IsRelative(const Value: string): Boolean;
  begin
    Result := not ((Value <> '') and (Value[1] = '\'));
  end;
var
  TempKey: HKey;
  S: string;
  Relative: Boolean;
begin
  S := Key;
  Relative := IsRelative(S);
  if not Relative then Delete(S, 1, 1);
  TempKey := 0;
  Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
    KEY_READ, TempKey) = ERROR_SUCCESS;
  if Result then
  begin
    if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
    ChangeKey(TempKey, S);
  end;
end;

function GetBIOSDate: string;
const
  BIOSDatePtr = $0ffff5;
  SystemKey = 'HARDWARE\DESCRIPTION\System';
  BiosDateParam = 'SystemBiosDate';
var
  p: pointer;
  s: string[128];
begin
  if OSisNT then
  begin
    with TRegistryRO.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyRO(SystemKey) then
      begin
        s := ReadString(BiosDateParam);
      end;
    finally
      Free;
    end; { of try}
  end
  else
  try
    s[0] := #8;
    p := Pointer(BIOSDatePtr);
    Move (p^, s[1], 8);
  except
    FillChar (s[1], 8, '9');
  end; { of try}
  Result := Copy(s, 1, 2) + Copy(s, 4, 2) + Copy(s, 7, 2);
end;

function GetVideoDate : string;
const
  VideoDatePtr = $0C0000;
  SystemKey = 'HARDWARE\DESCRIPTION\System';
  VideoDateParam = 'VideoBiosDate';
var
  p: pointer;
  s: string[255];
begin
  if OSisNT then
  begin
    with TRegistryRO.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyRO(SystemKey) then
        s := ReadString (VideoDateParam)
      else
        s := 'NT/de/tected';
    finally
      Free;
    end; { of try}
  end
  else
  try
    s[0] := #255;
    p := Pointer(VideoDatePtr + 60); { первые $60 - строка CopyRight }
    Move(p^, s[1], 255);
    if Pos('/', s) > 2 then
      s := Copy(s, Pos('/', s) - 2, 8)
    else
    begin
      p := Pointer(VideoDatePtr + 60 + 250);
      Move(p^, s[1], 255);
      if Pos('/', s) > 2 then
        s := Copy(s, Pos('/', s) - 2, 8);
    end;
  except
    FillChar(s[1], 8, '9');
  end; { of try}
  Result := Copy(s, 1, 2) + Copy(s, 4, 2) + Copy(s, 7, 2);
end;


unit WAPIInfo;

interface

uses
  Registry, SysUtils, Windows;

procedure GetOSVerInfo(var OSID: DWORD; var OSStr: string);
function OSisNT: boolean;
procedure GetCPUInfo(var CPUID: DWORD; var CPUStr: string);
procedure GetMemInfo(var MemStr: string);

implementation

procedure GetOSVerInfo(var OSID: DWORD; var OSStr: string);
var
  OSVerInfo: TOSVersionInfo;
  Reg: TRegistry;
  s: string;
begin
  OSVerInfo.dwOSVersionInfoSize := SizeOf(OSVerInfo);
  GetVersionEx(OSVerInfo);
  OSID := OSVerInfo.dwPlatformID;
  case OSID of
    VER_PLATFORM_WIN32S: OSStr := 'Windows 3+';
    VER_PLATFORM_WIN32_WINDOWS: OSStr := 'Windows 95+';
    VER_PLATFORM_WIN32_NT:
    begin
      OSStr := 'Windows NT';
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey ('SYSTEM\CurrentControlSet\Control\', False) then
        try
          s := Reg.ReadString('ProductOptions')
        except
          s := ''
        end;
      if s = 'WINNT' then
        OSStr := OSStr + ' WorkStation'
      else if s = 'SERVERNT' then
        OSStr := OSStr + ' Server 3.5 &amp; hi'
      else if s = 'LANMANNT' then
        OSStr := OSStr + ' Advanced server 3.1';
      Reg.Free;
    end;
  end;
  with OSVerInfo do
    OSStr := OSStr + Format (' %d.%d (выпуск %d)',
     [dwMajorVersion, dwMinorVersion, LoWord(dwBuildNumber)]);
end;

function OSisNT : boolean;
var
  s: string;
  i: DWORD;
begin
  GetOSVerInfo(i, s);
  Result := (i = VER_PLATFORM_WIN32_NT);
end;

procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string);
var
  SI : TSystemInfo;
begin
  GetSystemInfo (SI);
  CPUID := SI.dwProcessorType;
  case CPUID of
    386: CPUStr := '80386-совместимый процессор';
    486: CPUStr := '80486-совместимый процессор';
    586: CPUStr := 'Pentium-совместимый процессор';
    else CPUStr := 'Неизвестный процессор';
  end;
{  case SI.wProcessorArchitecture of
    PROCESSOR_ARCHITECTURE_INTEL: ;
    MIPS
    ALPHA
    PPC
    UNKNOWN
   end; }
end;

procedure GetMemInfo (var MemStr : string);
var
  MemInfo: TMemoryStatus;
begin
  MemInfo.dwLength := SizeOf (MemInfo);
  GlobalMemoryStatus (MemInfo);
  with MemInfo do MemStr := Format ('ОЗУ: %0.2f M (свободно %0.2f M)'#$d+
   ' Файл подкачки: %0.2f M (свободно: %0.2f M)'#$d,
   [(dwTotalPhys div 1024) / 1024,
    (dwAvailPhys div 1024) / 1024,
    (dwTotalPageFile div 1024) / 1024,
    (dwAvailPageFile div 1024) / 1024]);
end;

end.

PS Возможно, эти процедуры не всегда дату возвращают но то что практически всегда для разных материнских/видео плат возвращаются разные значения - проверено, что мне собственно и требовалось.

Файл:Embim1701.png

Andrey Sorokin from sunny Saint-Petersburg anso@mail.ru Russian Technology http://attend.to/rt anso@rt.spb.ru


Author: Song
Source: Взято из http://forum.sources.ru
ID: 01365