Узнать параметры видеокарты

Друзья, подскажите как узнать информацию о видеокарте, т.е. как можно больше информации.

EnumDisplayDevices позволяет узнать только название видеокарты;
EnumDisplaySettings кое-что дает, но не дает например, объем памяти карты;

Видел упомянутую здесь кем-то программку TESTVESA, которая использует приблизительно такой код:

Код (Text):

1. mov AX, 4F00h   ; Считывание SuperVGA информации
2. mov DI, offset VESA_buf
3. Int 10h
4. // ***
5. mov DI, offset VESA_buf + 18 ; Обьём видеопамяти
6. mov AX, [DI]
7. shl AX, 6
8. WriteWord AX ; Объем памяти в килобайтах

Однако она возвращает неверное значение, например для моей ATI Radeon 9600 (256 Mb) она показывает 16 Mb.

Меня интересует например та информация, что отображается в окне свойств монитора/видеоадаптера на вкладке Адапрер (Рабочий стол->Свойства, Параметры, Дополнительно, Адаптер). Там представленны: Тип микросхем, Тип конвертера DAC, Объем памяти, Строка контролеера и сведения о BIOS.

 

Это в реестре.
Вот видеопамять, где-то рядом лежат и нужные тебе сведения.

Код (Text):

1. function SubStrEnd(pszTarget: PChar; pszScan: PChar): PChar;
2. var
3.  i: DWORD;
4. begin
5.  i := 0;
6.  while (pszScan[i] <> #0) and (pszTarget[i] <> #0) and (UpperCase(pszScan[i]) = UpperCase(pszTarget[i])) do inc(i);
7.  if pszTarget[i] = #0 then result := PChar(DWORD(pszScan) + i)
8.  else result := pszScan;
9. end;
10.  
11. function GetVideoMemory(Adapter: byte): DWORD;
12. var
13.  Key: HKEY;
14.  DataSize: DWORD;
15.  RealPath, Path: PChar;
16. begin
17.  RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\VIDEO', 0, KEY_READ, Key);
18.  RegQueryValueEx(Key, PChar('\Device\Video' + IntToStr(Adapter)), nil, nil, nil, @DataSize);
19.  Path := GetMemory(DataSize + 1);
20.  RegQueryValueEx(Key, PChar('\Device\Video' + IntToStr(Adapter)), nil, nil, PByte(Path), @DataSize);
21.  RegCloseKey(Key);
22.  RealPath := SubStrEnd('\REGISTRY\MACHINE\', Path);
23.  RegOpenKeyEx(HKEY_LOCAL_MACHINE, RealPath, 0, KEY_READ, Key);
24.  DataSize := 4;
25.  result := 0;
26.  RegQueryValueEx(Key, 'HardwareInformation.MemorySize', nil, nil, @result, @DataSize);
27.  RegCloseKey(Key);
28.  FreeMemory(Path);
29.  result := result shr 20;
30. end;
31.  
32. begin
33.  MessageBox(0, PChar('Video memory: ' + IntToStr(GetVideoMemory(0)) + 'Mb'), 'Video memory', 0);
34. end.

 

Я решил вопрос несколько иным образом, хотя смысл тот же:

Код (Text):

1. function BytesToStr(const i64Size: Int64): string;
2. const
3.    i64GB = 1024 * 1024 * 1024;
4.    i64MB = 1024 * 1024;
5.    i64KB = 1024;
6. begin
7.   if i64Size div i64GB > 0 then
8.     Result := Format('%.2f GB', [i64Size / i64GB])
9.   else if i64Size div i64MB > 0 then
10.     Result := Format('%.0f MB', [i64Size / i64MB])
11.   else if i64Size div i64KB > 0 then
12.     Result := Format('%.0f KB', [i64Size / i64KB])
13.   else
14.     Result := IntToStr(i64Size) + ' Byte(s)';
15. end;
16.  
17. // Читает бинарные данные как UNICODE cnhjre и конвертирует их в в ASCII
18. function ReadBinStr(RKey: TRegistry; Value: string): string;
19. const
20.   MaxLen = 1024;
21. var
22.   Buff    : array[0..MaxLen] of Byte;
23.   ReadLen : Integer;
24.   i       : Integer;
25. begin
26.  ZeroMemory(@Buff, MaxLen);
27.  ReadLen := RKey.ReadBinaryData(Value, Buff, MaxLen);
28.  Result := '';
29.  // Просто возьмем каждый второй байт, вместо
30.  // глючных UnicodeToUtf8 и т.п.
31.  for i := 0 to ReadLen do
32.    if Buff[i*2] <> 0 then
33.      Result := Result + Chr(Buff[i*2])
34.    else Break;
35. end;
36.  
37. // Читает бинарные данные как Integer
38. function ReadBinInt(RKey: TRegistry; Value: string): Integer;
39. var
40.   Buff    : DWORD;
41. begin
42.  Buff := 0;
43.  RKey.ReadBinaryData(Value, Buff, 4);
44.  Result := Buff;
45. end;
46.  
47. // Читает информацию о адаптере из реестра и добавляет ее в Memo
48. procedure TForm1.ReadAdapterInfo(DeviceString: string);
49. var
50.   RKey    : TRegistry;
51.   SubKeys : TStrings;
52.   i       : Integer;
53. begin
54.  RKey := TRegistry.Create;
55.  RKey.RootKey := HKEY_LOCAL_MACHINE;
56.  if not RKey.KeyExists('SYSTEM\CurrentControlSet\Control\Video')
57.    then LogMemo.Lines.Add('   Error - невозможно получить данные')
58.    else
59.      begin
60.        RKey.OpenKey('SYSTEM\CurrentControlSet\Control\Video', False);
61.        SubKeys := TStringList.Create;
62.        RKey.GetKeyNames(SubKeys);
63.        for i := 0 to SubKeys.Count-1 do
64.          if RKey.KeyExists(SubKeys[i]+'\0000')
65.            then
66.              begin
67.                RKey.OpenKey(SubKeys[i]+'\0000', False);
68.                if RKey.ValueExists('Device Description') and
69.                   (RKey.ReadString('Device Description') = DeviceString)
70.                   then if RKey.ValueExists('HardwareInformation.AdapterString') then
71.                   // Найденно указанное в DeviceString устройство
72.                   begin
73.                     LogMemo.Lines.Add('   Адаптер: '+ReadBinStr(RKey, 'HardwareInformation.AdapterString'));
74.                     LogMemo.Lines.Add('   Тип микросхем: '+ReadBinStr(RKey, 'HardwareInformation.ChipType'));
75.                     LogMemo.Lines.Add('   Строка BIOS: '+ReadBinStr(RKey, 'HardwareInformation.BiosString'));
76.                     LogMemo.Lines.Add('   Конвертер DAC: '+ReadBinStr(RKey, 'HardwareInformation.DacType'));
77.                     LogMemo.Lines.Add('   Память: '+BytesToStr(ReadBinInt(RKey, 'HardwareInformation.MemorySize')));
78.                   end else LogMemo.Lines.Add('   Нет информации');
79.                RKey.CloseKey;
80.                RKey.OpenKey('SYSTEM\CurrentControlSet\Control\Video', False);
81.              end;
82.        SubKeys.Free;
83.      end;
84. end;
85.  
86. // Перечисляет информацию о адаптерах (реальных и виртуальных,
87. // например от NetMeeting'а) и получает инфу для каждого
88. procedure TForm1.Button1Click(Sender: TObject);
89. var
90.   lpDisplayDevice : TDisplayDevice;
91.   dwFlags         : DWORD;
92.   cc              : DWORD;
93. begin
94.  LogMemo.Lines.Clear;
95.  lpDisplayDevice.cb := sizeof(lpDisplayDevice);
96.  dwFlags := 0;
97.  cc := 0;
98.  while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do
99.   begin
100.     Inc(cc);
101.     if lpDisplayDevice.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE =
102.       DISPLAY_DEVICE_PRIMARY_DEVICE then // Основной монитор
103.         LogMemo.Lines.Add(lpDisplayDevice.DeviceString + ' (Основной)')
104.       else
105.         LogMemo.Lines.Add(lpDisplayDevice.DeviceString);
106.     ReadAdapterInfo(lpDisplayDevice.DeviceString);
107.   end;
108. end;

Но все-равно огромное спасибо.