Форум: "Основная";
Текущий архив: 2004.12.26;
Скачать: [xml.tar.bz2];
Вниз
Как пролучить информацию о BIOSе? Найти похожие ветки
← →
SpideRUS (2004-12-03 12:25) [0]Требуется получить инфо биосе. Нашел два примера:
procedure TBIOSInfo.GetRegInfoWinNT;
var
Registryv: TRegistry;
RegPath: string;
sl: TStrings;
begin
Params.Clear;
RegPath := "\HARDWARE\DESCRIPTION\System";
registryv := tregistry.Create;
registryv.rootkey := HKEY_LOCAL_MACHINE;
sl := nil;
try
registryv.Openkey(RegPath, false);
ShowMessage("BIOS Date: " + RegistryV.ReadString("SystemBiosDate"));
sl := ReadMultirowKey(RegistryV, "SystemBiosVersion");
ShowMessage("BIOS Version: " + sl.Text);
except
end;
Registryv.Free;
if Assigned(sl) then
sl.Free;
end;
========
// следующий метод получает многострочные значения из реестра
// и преобразует их в TStringlist
function ReadMultirowKey(reg: TRegistry; Key: string): TStrings;
const
bufsize = 100;
var
i: integer;
s1: string;
sl: TStringList;
bin: array[1..bufsize] of char;
begin
try
result := nil;
sl := nil;
sl := TStringList.Create;
if not Assigned(reg) then
raise Exception.Create("TRegistry object not assigned.");
FillChar(bin, bufsize, #0);
reg.ReadBinaryData(Key, bin, bufsize);
i := 1;
s1 := "";
while i < bufsize do
begin
if ord(bin[i]) >= 32 then
s1 := s1 + bin[i]
else
begin
if Length(s1) > 0 then
begin
sl.Add(s1);
s1 := "";
end;
end;
inc(i);
end;
result := sl;
except
sl.Free;
raise;
end;
end;
Ругается что Undeclaraed identifier "TRegistry". Может в uses нужно чего-нить добавить?
← →
ssk © (2004-12-03 12:30) [1]>Может в uses нужно чего-нить добавить
да. Registry
← →
SpideRUS (2004-12-03 12:52) [2]Registry уже добавил ;-) теперь на Params ругается.
Как вообще определять какой модуль нужен, чтобы не перебирать и не просматривать их?
← →
Anton_K © (2004-12-03 13:06) [3]Как вообще определять какой модуль нужен
Смотреть в хелпе.
← →
SpideRUS (2004-12-03 13:15) [4]2Anton_K ©
> Смотреть в хелпе.
Смотрел, но не нашел. Может я не там искал?
← →
BURN © (2004-12-04 01:51) [5]видел раньше этот код, просто пиши
//Params.Clear;
и лучше вместоsl.Text
пишиsl.CommaText
просто не всегда можно прочитать первым способом(например 2000 server)
← →
grigory © (2004-12-04 10:22) [6]вобще сотри этот params,он не нужен..
← →
SpideRUS (2004-12-06 08:16) [7]Теперь на ReadMultirowKey ругается.
← →
Frozzen (2004-12-06 08:34) [8]http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=988621412&n=15
← →
Gloomer © (2004-12-06 11:33) [9]2 Frozzen (06.12.04 08:34) [8]
Хорошая ссылка, но содержит сного лишнего и сразу не все ясно, что с кодом делать. Так получилось, что меня также затронула тема привязки программы к конкретному компу.
Привожу, что получилось у меня, может кому пригодится
Копирайт первоисточника (хотя пришлось переработать все)
Andrey Sorokin from sunny ;) Saint-Petersburg anso@mail.ru
Russian Technology http://attend.to/rt anso@rt.spb.ru
---------------MyUnit.pas-----------------unit MyUnit;
{$WARN UNSAFE_TYPE OFF} // ну не люблю я эти предупреждения, не люблю :-)))
interface
uses Registry, Windows;
//ф-ция проверки ОС на пренадлежность к NT
function IsNT:boolean;
//ф-ция возвращает дату изготовления BIOS или видеокарты
function GetDate(GetType:integer):string;
//константы для GetDate, определяющие какую дату нужно получить
const gdBIOS=1;
gdVideo=2;
implementation
function IsNT:boolean;
var OS:TOSVersionInfo;
begin
OS.dwOSVersionInfoSize:=SizeOf(OS);
GetVersionEx(OS);
Result:=(OS.dwPlatformID=VER_PLATFORM_WIN32_NT);
end;
function GetDate(GetType:integer):string;
var Ptr:pointer;
s:string[255];
StrPos:integer;
const ErrDate="00/00/00"; //какая дата вернется в случае ошибки
begin
s:=ErrDate;
if IsNT then
with TRegistry.Create do
try
RootKey:=HKEY_LOCAL_MACHINE;
//доступ к реестру по умолчанию полный и поэтому без этой
//строки для неАдмина OpenKey всегда выдавал false
Access:=KEY_READ;
if OpenKey("HARDWARE\DESCRIPTION\System",false)
then
case GetType of
gdBIOS: s:=ReadString("SystemBiosDate");
gdVideo: s:=ReadString("VideoBiosDate");
else s:=ErrDate;
end; {case}
finally Free;
end {try1}
else
try case GetType of
gdBIOS: begin {c1}
Ptr:=pointer($0ffff5);
s[0]:=#8;//а нам больше и не надо, адрес известен точно
Move(Ptr^,s[1],8);
end; {c1}
gdVideo: begin {c2}
Ptr:=pointer($0C0000);
//а здесь адрес неизвестен, точнее, он будет разным
//для разных производителей видеокарт, придется поискать
repeat
s[0]:=#255;
Move(Ptr^,s[1],255);
StrPos:=pos("/",s);
//нас устроит только StrPos=3..250,
//иначе не влезет начало или хвост строки
if ((StrPos>2)and(StrPos<251))
then
begin
s:=copy(s,StrPos-2,8);
//на случай если не наша строка
Ptr:=pointer(integer(Ptr)+StrPos-1);
end
else Ptr:=pointer(integer(Ptr)+248);
//дата видеокарты должна быть в первых 512 байтах видеопамяти, хотя практика
//показывает, что 128 байт обычно достаточно. Но все же на всякий случай...
until ((integer(Ptr)>$0C0200) or
((s[3]="/")and(s[6]="/")));
end; {c2}
else {case} s:=ErrDate;
end; {case}
except s:=ErrDate;
end; {try}
if not((s[3]="/")and(s[6]="/"))then s:=ErrDate;
Result:=copy(s,1,8);
//как вариант получения даты без "/"
{ Result:=copy(s,1,2)+copy(s,4,2)+copy(s,7,2);}
end;
end.
-----------------------------------------------------
применение:uses MyUnit;
...
Label1.Caption:="Дата BIOS: "+GetDate(gdBIOS);
Label2.Caption:="Дата Video: "+GetDate(gdVideo);
...
Код тестировал на разных компах и разных ОС (9х, 2к, ХР) -
вроде работает.
Даты совпадают с выдаваемыми SiSandra
Хотелось бы знать, если у кого-то этот код не пойдет...
Соображения о том, что делать с полученными датами оставлю для себя - пригодится воды напиться :-))
← →
SpideRUS (2004-12-09 07:13) [10]Премного благодарен.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.12.26;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.065 c
