Как получить информацию о БИОСе?
Как получить информацию о БИОСе?
Как получить информацию о БИОСе? Вот пример как можно выдрать даты БИОС материнской платы и видеокарты. То же самое можно с названием производителя и версией. В 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 = 'hardwaredescriptionsystem'; 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 = 'hardwaredescriptionsystem'; 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); implementationprocedure 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 ('systemcurrentcontrolsetcontrol', 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 & 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 Возможно, эти процедуры не всегда дату возвращают ;) но то что практически всегда для разных материнских/видео плат возвращаются разные значения - проверено, что мне собственно и требовалось.