Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.035 c
3-1101215098
and
2004-11-23 16:04
2004.12.26
Summary Footer в dxDBGrid и его работа с дробными числами


6-1097472068
Slonco
2004-10-11 09:21
2004.12.26
В отправленном письме абракадабра...


3-1101264381
able
2004-11-24 05:46
2004.12.26
У каждой фирмы свой прайс


9-1093004228
Megabyte-Ceercop
2004-08-20 16:17
2004.12.26
Игра растет в памяти после каждого ГеймОвера


3-1101280714
Nexel
2004-11-24 10:18
2004.12.26
IBX и обновление данных





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский