| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как пролучить информацию о BIOSе? [D7, WinXP]
SpideRUS © (2004-12-03 12:25:00)Требуется получить инфо биосе. Нашел два примера:
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 нужно чего-нить добавить?
SpideRUS (2004-12-09 07:13:00) [1]Премного благодарен.
Gloomer (2004-12-06 11:33:00) [2]2 Frozzen (06.12.04 08:34) [8]
Хорошая ссылка, но содержит сного лишнего и сразу не все ясно, что с кодом делать. Так получилось, что меня также затронула тема привязки программы к конкретному компу.
Привожу, что получилось у меня, может кому пригодится
Копирайт первоисточника (хотя пришлось переработать все)
Andrey Sorokin from sunny ;) Saint-Petersburg anso@mail.ru
Russian Technology http://attend.to/rtanso@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
Хотелось бы знать, если у кого-то этот код не пойдет...
Соображения о том, что делать с полученными датами оставлю для себя - пригодится воды напиться :-))
Frozzen (2004-12-06 08:34:00) [3]http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=988621412&n=15
SpideRUS (2004-12-06 08:16:00) [4]Теперь на ReadMultirowKey ругается.
grigory (2004-12-04 10:22:00) [5]вобще сотри этот params,он не нужен..
BURN (2004-12-04 01:51:00) [6]видел раньше этот код, просто пиши
//Params.Clear;
и лучше вместо
sl.Text
пиши
sl.CommaText
просто не всегда можно прочитать первым способом(например 2000 server)
SpideRUS (2004-12-03 13:15:00) [7]2Anton_K ©
> Смотреть в хелпе.
Смотрел, но не нашел. Может я не там искал?
Anton_K (2004-12-03 13:06:00) [8]Как вообще определять какой модуль нужен
Смотреть в хелпе.
SpideRUS (2004-12-03 12:52:00) [9]Registry уже добавил ;-) теперь на Params ругается.
Как вообще определять какой модуль нужен, чтобы не перебирать и не просматривать их?
ssk (2004-12-03 12:30:00) [10]>Может в uses нужно чего-нить добавить
да. Registry
| |
