Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.12.26;
Скачать: CL | DM;

Вниз

Как пролучить информацию о 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;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.287 c
3-1101107259
MakNik
2004-11-22 10:07
2004.12.26
dxDBGrid


3-1101369676
Сергей Медведев
2004-11-25 11:01
2004.12.26
Права в FireBird


9-1093586545
Nic
2004-08-27 10:02
2004.12.26
Помогите!


8-1096044372
Antonmm2
2004-09-24 20:46
2004.12.26
Разделение AVI файла


1-1103098241
vik_b
2004-12-15 11:10
2004.12.26
BringToFront или SetActiveWindow