VPF::Чтение бинарных данных из реестра

Zlo

Дата 14.4.2012, 19:39 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: 1
Всего: 1

В реестре хранятся EDID дынные которые винда получает от монитора.
По ключу (HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\DISPLAY\VSC6B20\4&4a1bbf5&0&UID16843008\Device Parameters)
параметр EDID (Выделенная часть у каждого компьютера будет разная, ее можно получить с помощью WMI см. код. процедура GetWmiMonitorIDInfo).

Из этих данных нужно выдернуть производителя и модель монитора.
Впринципе если двоичные данные перевести в текст то производителя и модель можно прочитать, но сделать это никак не получается.

Дабы не быть голословным, вот код в котором я пытаюсь получить EDID в текстовом виде:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX,ComObj, Registry;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;

procedure  GetWmiMonitorIDInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  s             :String;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\WMI', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WmiMonitorID','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    S:=FWbemObject.InstanceName;
    S:=Copy(S,1,AnsiPos('_',S)-1);
    Form1.Memo1.Lines.Add(S);
    FWbemObject:=Unassigned;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
reg : TRegistry;
mon :array of String;
i,j,size  :integer;
EDID2: array of Char;
begin
    Memo1.Lines.Clear;
    Memo2.Lines.Clear;

    GetWmiMonitorIDInfo;

    reg := TRegistry.Create;
    j:=0;
    for I := 0 to Memo1.Lines.Count - 1 do begin
      if Length(Memo1.Lines.Strings[i])>0 then j:=j+1;
    end;

    SetLength(mon,j);

    for i := 0 to Length(mon) - 1 do
      if Length(Memo1.Lines.Strings[i])>0 then mon[i]:=Memo1.Lines.Strings[i];
 i:=0;
 with reg do
 begin
   Rootkey:=HKEY_LOCAL_MACHINE;
     if OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+mon[i]+'\Device Parameters') then
     begin
       size:=Reg.GetDataSize('EDID');
       ShowMessage(IntToStr(size));
       SetLength(EDID2,size);
       ReadBinaryData('EDID', EDID2, Size);
     end else ShowMessage('Error');
   end;
 reg.Free;

 Memo2.Text:=PChar(EDID2);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    ShowMessage(GetComputerNetName);
end;

end.

Ничего не получается, вылезает ошибка доступа к памяти.
Помогите плиз!

Illusion Dolphin

Дата 14.4.2012, 19:59 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63

Посмотрите тут - http://forum.ru-board.com/topic.cgi?forum=33&topic=11911 .

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

Zlo

Дата 14.4.2012, 20:21 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: 1
Всего: 1

Смотрел, у меня тот код нули показывает.
и кажется мне что структура рекорда там не правильная...

Illusion Dolphin

Дата 15.4.2012, 00:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63

Посмотрел - эти данные зависят как от Windows (в win7 там 256 битов, хотя 127 только не ноль), так и от монитора - есть разные ревизии.

Так что просто считать в строку вот так:

Код


type
  TEDIDHeader = record
    empty1: array[0..127] of byte;
    empty2: array[0..127] of byte;//Win7 
  end;
var
 reg : TRegistry;
 EDID : TEDIDHeader;
 B: Byte;
begin
 reg := TRegistry.Create;
 with reg do
 begin
   Rootkey:=HKEY_LOCAL_MACHINE; //Hauptschlüssel
   if RegistryConnect('\\'+GetEnvironmentVariable('COMPUTERNAME')) = True then
   begin
     if OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\DISPLAY\???\???\Device Parameters') then
     begin
       ReadBinaryData('EDID', EDID, SizeOf(EDID));

       Caption := '';
       for B in EDID.empty1 do
         Caption := Caption + AnsiChar(B);

     end;
   end;
 end;
 reg.Free;

А дальше надо читать вот тут http://en.wikipedia.org/wiki/Extended_disp...tification_data чтобы сформировать правильно рекорд

--------------------

Zlo

Дата 15.4.2012, 12:06 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: 1
Всего: 1

Цитата(Illusion Dolphin @ 15.4.2012, 00:36

)

А дальше надо читать вот тут http://en.wikipedia.org/wiki/Extended_disp...tification_data чтобы сформировать правильно рекорд

Боюсь я это не осилю=)
Как мне получить данные из EDID скажем в Memo?

Zlo

Дата 17.4.2012, 15:11 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: 1
Всего: 1

Вобщем никто помоч мне не захотел, в итоге решение такое:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX,ComObj, Registry;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;

procedure  GetWmiMonitorIDInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  s             :String;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\WMI', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM WmiMonitorID','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    S:=FWbemObject.InstanceName;
    S:=Copy(S,1,AnsiPos('_',S)-1);
    Form1.Memo1.Lines.Add(S);
    FWbemObject:=Unassigned;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const HEXSimb:array [0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
type tar=array[0..0] of byte;

var
reg : TRegistry;
mon :array of String;
i,j,size  :integer;
EDID2: array of Byte;
addr:integer;
    NumStr:array [0..511] of char;
    ar:^tar;
    stepstr:integer;
begin
    Memo1.Lines.Clear;
    Memo2.Lines.Clear;

    GetWmiMonitorIDInfo;

    reg := TRegistry.Create;
    j:=0;
    for I := 0 to Memo1.Lines.Count - 1 do begin
      if Length(Memo1.Lines.Strings[i])>0 then j:=j+1;
    end;

    SetLength(mon,j);

    for i := 0 to Length(mon) - 1 do
      if Length(Memo1.Lines.Strings[i])>0 then mon[i]:=Memo1.Lines.Strings[i];
 i:=0;
 //for j := 0 to i - 1 do begin

 with reg do
 begin
   Rootkey:=HKEY_LOCAL_MACHINE;
     if OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+mon[i]+'\Device Parameters') then
     begin
       size:=Reg.GetDataSize('EDID');
       ShowMessage(IntToStr(size));
       SetLength(EDID2,size);
       ShowMessage('reading');
       ReadBinaryData('EDID', EDID2[0], size);
     end else ShowMessage('Error');
   end;
 reg.Free;

 //Memo2.Text:=string(EDID2);
  //{
  addr:=0;
 // ar:=edid2;
  while addr<Length(EDID2) do
    begin
       NumStr[0]:=HEXSimb[addr shr 4];
      NumStr[1]:=HEXSimb[addr and $0F];
      NumStr[2]:=':';
      NumStr[3]:=' ';

        for i:=0 to 8 do
        begin
            NumStr[i*3+4]:=HEXSimb[(edid2[addr+i] shr 4)];
              NumStr[i*3+5]:=HEXSimb[(edid2[addr+i] and $0f)];
          NumStr[i*3+6]:=' ';
          end;

      NumStr[7*3+7]:=#0;
        Memo2.Lines.Add(NumStr);
      inc(addr, 8);
    end;
    stepstr:=0;
    for I := 0 to Length(EDID2) - 1 do begin
        //Memo2.Lines.Add(chr(Edid2[i]));
        Memo2.Text:=Memo2.Text+chr(Edid2[i]);
        if stepstr>=8 then begin
          stepstr:=0;
          Memo2.Lines.Add('');
          continue;
        end;
        inc(stepstr);


    end;
    //}
end;

Если кто кинет актуальное описание EDID буду благодарен, кажется последняя версия 1.4
доступ к документам VESA можно получить тут:
Follow the instructions below to download VESA Public Standards:
1) Go to https:_/vesa.sharedwork.com/
2) Enter in the "Email address": pubstd
3) Enter in the "Password": getnow9

Это сообщение отредактировал(а) Zlo - 17.4.2012, 15:12

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »