Друзья, подскажите как узнать информацию о видеокарте, т.е. как можно больше информации. EnumDisplayDevices позволяет узнать только название видеокарты; EnumDisplaySettings кое-что дает, но не дает например, объем памяти карты; Видел упомянутую здесь кем-то программку TESTVESA, которая использует приблизительно такой код: Код (Text): mov AX, 4F00h ; Считывание SuperVGA информации mov DI, offset VESA_buf Int 10h // *** mov DI, offset VESA_buf + 18 ; Обьём видеопамяти mov AX, [DI] shl AX, 6 WriteWord AX ; Объем памяти в килобайтах Однако она возвращает неверное значение, например для моей ATI Radeon 9600 (256 Mb) она показывает 16 Mb. Меня интересует например та информация, что отображается в окне свойств монитора/видеоадаптера на вкладке Адапрер (Рабочий стол->Свойства, Параметры, Дополнительно, Адаптер). Там представленны: Тип микросхем, Тип конвертера DAC, Объем памяти, Строка контролеера и сведения о BIOS.
Это в реестре. Вот видеопамять, где-то рядом лежат и нужные тебе сведения. Код (Text): function SubStrEnd(pszTarget: PChar; pszScan: PChar): PChar; var i: DWORD; begin i := 0; while (pszScan[i] <> #0) and (pszTarget[i] <> #0) and (UpperCase(pszScan[i]) = UpperCase(pszTarget[i])) do inc(i); if pszTarget[i] = #0 then result := PChar(DWORD(pszScan) + i) else result := pszScan; end; function GetVideoMemory(Adapter: byte): DWORD; var Key: HKEY; DataSize: DWORD; RealPath, Path: PChar; begin RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\VIDEO', 0, KEY_READ, Key); RegQueryValueEx(Key, PChar('\Device\Video' + IntToStr(Adapter)), nil, nil, nil, @DataSize); Path := GetMemory(DataSize + 1); RegQueryValueEx(Key, PChar('\Device\Video' + IntToStr(Adapter)), nil, nil, PByte(Path), @DataSize); RegCloseKey(Key); RealPath := SubStrEnd('\REGISTRY\MACHINE\', Path); RegOpenKeyEx(HKEY_LOCAL_MACHINE, RealPath, 0, KEY_READ, Key); DataSize := 4; result := 0; RegQueryValueEx(Key, 'HardwareInformation.MemorySize', nil, nil, @result, @DataSize); RegCloseKey(Key); FreeMemory(Path); result := result shr 20; end; begin MessageBox(0, PChar('Video memory: ' + IntToStr(GetVideoMemory(0)) + 'Mb'), 'Video memory', 0); end.
Я решил вопрос несколько иным образом, хотя смысл тот же: Код (Text): function BytesToStr(const i64Size: Int64): string; const i64GB = 1024 * 1024 * 1024; i64MB = 1024 * 1024; i64KB = 1024; begin if i64Size div i64GB > 0 then Result := Format('%.2f GB', [i64Size / i64GB]) else if i64Size div i64MB > 0 then Result := Format('%.0f MB', [i64Size / i64MB]) else if i64Size div i64KB > 0 then Result := Format('%.0f KB', [i64Size / i64KB]) else Result := IntToStr(i64Size) + ' Byte(s)'; end; // Читает бинарные данные как UNICODE cnhjre и конвертирует их в в ASCII function ReadBinStr(RKey: TRegistry; Value: string): string; const MaxLen = 1024; var Buff : array[0..MaxLen] of Byte; ReadLen : Integer; i : Integer; begin ZeroMemory(@Buff, MaxLen); ReadLen := RKey.ReadBinaryData(Value, Buff, MaxLen); Result := ''; // Просто возьмем каждый второй байт, вместо // глючных UnicodeToUtf8 и т.п. for i := 0 to ReadLen do if Buff[i*2] <> 0 then Result := Result + Chr(Buff[i*2]) else Break; end; // Читает бинарные данные как Integer function ReadBinInt(RKey: TRegistry; Value: string): Integer; var Buff : DWORD; begin Buff := 0; RKey.ReadBinaryData(Value, Buff, 4); Result := Buff; end; // Читает информацию о адаптере из реестра и добавляет ее в Memo procedure TForm1.ReadAdapterInfo(DeviceString: string); var RKey : TRegistry; SubKeys : TStrings; i : Integer; begin RKey := TRegistry.Create; RKey.RootKey := HKEY_LOCAL_MACHINE; if not RKey.KeyExists('SYSTEM\CurrentControlSet\Control\Video') then LogMemo.Lines.Add(' Error - невозможно получить данные') else begin RKey.OpenKey('SYSTEM\CurrentControlSet\Control\Video', False); SubKeys := TStringList.Create; RKey.GetKeyNames(SubKeys); for i := 0 to SubKeys.Count-1 do if RKey.KeyExists(SubKeys[i]+'\0000') then begin RKey.OpenKey(SubKeys[i]+'\0000', False); if RKey.ValueExists('Device Description') and (RKey.ReadString('Device Description') = DeviceString) then if RKey.ValueExists('HardwareInformation.AdapterString') then // Найденно указанное в DeviceString устройство begin LogMemo.Lines.Add(' Адаптер: '+ReadBinStr(RKey, 'HardwareInformation.AdapterString')); LogMemo.Lines.Add(' Тип микросхем: '+ReadBinStr(RKey, 'HardwareInformation.ChipType')); LogMemo.Lines.Add(' Строка BIOS: '+ReadBinStr(RKey, 'HardwareInformation.BiosString')); LogMemo.Lines.Add(' Конвертер DAC: '+ReadBinStr(RKey, 'HardwareInformation.DacType')); LogMemo.Lines.Add(' Память: '+BytesToStr(ReadBinInt(RKey, 'HardwareInformation.MemorySize'))); end else LogMemo.Lines.Add(' Нет информации'); RKey.CloseKey; RKey.OpenKey('SYSTEM\CurrentControlSet\Control\Video', False); end; SubKeys.Free; end; end; // Перечисляет информацию о адаптерах (реальных и виртуальных, // например от NetMeeting'а) и получает инфу для каждого procedure TForm1.Button1Click(Sender: TObject); var lpDisplayDevice : TDisplayDevice; dwFlags : DWORD; cc : DWORD; begin LogMemo.Lines.Clear; lpDisplayDevice.cb := sizeof(lpDisplayDevice); dwFlags := 0; cc := 0; while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do begin Inc(cc); if lpDisplayDevice.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE = DISPLAY_DEVICE_PRIMARY_DEVICE then // Основной монитор LogMemo.Lines.Add(lpDisplayDevice.DeviceString + ' (Основной)') else LogMemo.Lines.Add(lpDisplayDevice.DeviceString); ReadAdapterInfo(lpDisplayDevice.DeviceString); end; end; Но все-равно огромное спасибо.
