Как получить информацию о БИОСе?
Автор: admin
Вот пример как можно даты БИОС материнской платы и видеокарты выдрать.
То же самое можно с названием производителя и версией.
В winnt приходится читать не из ПЗУ а из реестра но это достаточно надежно
- соотв ключи winnt закрывает на запись и обновляет при каждом старте (?).
Для win9x можешь хоть весь БИОС напрямую читать.
Получить заводской номер винчестера (не тот что getvolumeinfo дает) ИМХО
невозможно - порты ide даже win9x блокирует.
typetregistryro = class (tregistry)
function openkeyro (const key: string): boolean;
end;{ это уже ветхая история - был один глюк у d3}
implementationuses 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 = 'hardwarede scriptionsystem';
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 = 'hardwarede scriptionsystem';
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;interfaceuses 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.dwplat formid;
case osid of ver_plat form_win32s : osstr := 'windows 3+';
ver_plat form_win32_windows : osstr := 'windows 95+';
ver_plat form_win32_nt :
begin
osstr := 'windows nt';
reg := tregistry.create;
reg.rootkey := hkey_local_machine;
if reg.openkey ('systemcurrentcontrolsetcontrol', false) then try s := reg.readstring ('product options')
except s := ''
end;
if s = 'winnt' then osstr := osstr + ' workstation'
else if s = 'servernt' then osstr := osstr + ' server 3.5 & 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_plat form_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 Возможно, эти процедуры не всегда дату возвращают ;)
но то что практически всегда для разных материнских/видео
плат возвращаются разные значения - проверено, что мне
собственно и требовалось.
То же самое можно с названием производителя и версией.
В winnt приходится читать не из ПЗУ а из реестра но это достаточно надежно
- соотв ключи winnt закрывает на запись и обновляет при каждом старте (?).
Для win9x можешь хоть весь БИОС напрямую читать.
Получить заводской номер винчестера (не тот что getvolumeinfo дает) ИМХО
невозможно - порты ide даже win9x блокирует.
typetregistryro = class (tregistry)
function openkeyro (const key: string): boolean;
end;{ это уже ветхая история - был один глюк у d3}
implementationuses 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 = 'hardwarede scriptionsystem';
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 = 'hardwarede scriptionsystem';
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;interfaceuses 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.dwplat formid;
case osid of ver_plat form_win32s : osstr := 'windows 3+';
ver_plat form_win32_windows : osstr := 'windows 95+';
ver_plat form_win32_nt :
begin
osstr := 'windows nt';
reg := tregistry.create;
reg.rootkey := hkey_local_machine;
if reg.openkey ('systemcurrentcontrolsetcontrol', false) then try s := reg.readstring ('product options')
except s := ''
end;
if s = 'winnt' then osstr := osstr + ' workstation'
else if s = 'servernt' then osstr := osstr + ' server 3.5 & 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_plat form_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 Возможно, эти процедуры не всегда дату возвращают ;)
но то что практически всегда для разных материнских/видео
плат возвращаются разные значения - проверено, что мне
собственно и требовалось.
Комментарии
Нет комментариев. Вы можете быть первым!