Проблема Определение памяти VGA

ROMKA-1977 · Вчера в 13:31

Перепробовал все известные методы определения системы но ни один из них не определяет правильно память современных VGA. Накидал свой код определения системы. Возможно ли к нему добавить определение памяти VGA ?

Код:

var
  Memo: TNewMemo;
  Page: TWizardPage;

// ------------------- Вспомогательные функции -------------------
function RoundMemoryToMiB(MemMb: Integer): Integer;
begin
  Result := ((MemMb + 512) div 1024) * 1024;
end;

function FormatGB(Value: Int64): String;
var
  TotalGB: Double;
  Whole, Frac: Integer;
begin
  TotalGB := Value * 1.0 / 1024 / 1024 / 1024;
  Whole := Trunc(TotalGB);
  Frac := Round((TotalGB - Whole) * 100);
  if Frac < 10 then
    Result := IntToStr(Whole) + '.0' + IntToStr(Frac)
  else
    Result := IntToStr(Whole) + '.' + IntToStr(Frac);
end;

// ------------------- Получение CPU -------------------
function GetCPUInfo(): String;
var
  WbemLocator, WbemServices, CPUs, CPU: Variant;
  i: Integer;
begin
  Result := '';
  WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
  CPUs := WbemServices.ExecQuery('SELECT * FROM Win32_Processor');

  for i := 0 to CPUs.Count - 1 do
  begin
    CPU := CPUs.ItemIndex(i);
    if Result <> '' then Result := Result + #13#10;
    Result := Result +
      'CPU: ' + String(CPU.Name) + #13#10 +
      'Physical Cores: ' + IntToStr(CPU.NumberOfCores) + #13#10 +
      'Logical Processors: ' + IntToStr(CPU.NumberOfLogicalProcessors);
  end;
end;

// ------------------- Получение RAM -------------------
function GetRAMInfo(): String;
var
  WbemLocator, WbemServices, CompSys: Variant;
  TotalMemMb: Integer;
begin
  Result := '';
  WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
  CompSys := WbemServices.ExecQuery('SELECT * FROM Win32_ComputerSystem');

  if CompSys.Count > 0 then
  begin
    TotalMemMb := Int64(CompSys.ItemIndex(0).TotalPhysicalMemory) div 1024 div 1024;
    TotalMemMb := RoundMemoryToMiB(TotalMemMb);
    Result := 'Total RAM: ' + IntToStr(TotalMemMb) + ' MB';
  end;
end;

// ------------------- Получение материнской платы -------------------
function GetMotherboard(): String;
var
  WbemLocator, WbemServices, Boards: Variant;
begin
  Result := '';
  WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
  Boards := WbemServices.ExecQuery('SELECT * FROM Win32_BaseBoard');

  if Boards.Count > 0 then
    Result := 'Motherboard: ' + String(Boards.ItemIndex(0).Manufacturer) + ' ' +
              String(Boards.ItemIndex(0).Product);
end;

// ------------------- Получение видеокарты -------------------
function GetGPUInfo(): String;
var
  WbemLocator, WbemServices, GPUs, GPU: Variant;
  i: Integer;
begin
  Result := '';
  WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
  GPUs := WbemServices.ExecQuery('SELECT * FROM Win32_VideoController');

  for i := 0 to GPUs.Count - 1 do
  begin
    GPU := GPUs.ItemIndex(i);
    if Result <> '' then Result := Result + #13#10;
    Result := Result + 'GPU: ' + String(GPU.Name);
  end;
end;

// ------------------- Получение звуковых карт -------------------
function GetSoundInfo(): String;
var
  WbemLocator, WbemServices, Sounds, Sound: Variant;
  i: Integer;
begin
  Result := '';
  WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
  Sounds := WbemServices.ExecQuery('SELECT * FROM Win32_SoundDevice');

  for i := 0 to Sounds.Count - 1 do
  begin
    Sound := Sounds.ItemIndex(i);
    if Result <> '' then Result := Result + #13#10;
    Result := Result + 'Sound Device: ' + String(Sound.Name);
  end;

  if Result = '' then
    Result := 'Sound Device not found';
end;

// ------------------- Получение ОС -------------------
function GetOSInfo(): String;
var
  WbemLocator, WbemServices, OSs: Variant;
begin
  Result := '';
  WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
  OSs := WbemServices.ExecQuery('SELECT * FROM Win32_OperatingSystem');

  if OSs.Count > 0 then
    Result := 'OS: ' + String(OSs.ItemIndex(0).Caption) + ' (' +
              String(OSs.ItemIndex(0).OSArchitecture) + ')'
end;

// ------------------- Получение дисков -------------------
function GetDrivesInfo(): String;
var
  WbemLocator, WbemServices, Drives, Drive: Variant;
  Count, i: Integer;
  TotalGBInt, FreeGBInt: Int64;
  Info: String;
  VolumeName, FileSystem: String;
begin
  Result := '';
  WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
  Drives := WbemServices.ExecQuery('SELECT * FROM Win32_LogicalDisk WHERE DriveType=3 OR DriveType=2');
  Count := Drives.Count;

  if Count = 0 then Exit;

  Info := '';
  for i := 0 to Count - 1 do
  begin
    Drive := Drives.ItemIndex(i);
    if VarIsNull(Drive.Size) then Continue;
    TotalGBInt := Int64(Drive.Size);
    if TotalGBInt = 0 then Continue;

    if VarIsNull(Drive.FreeSpace) then FreeGBInt := 0
    else FreeGBInt := Int64(Drive.FreeSpace);

    if VarIsNull(Drive.VolumeName) then VolumeName := ''
    else VolumeName := String(Drive.VolumeName);

    if VarIsNull(Drive.FileSystem) then FileSystem := ''
    else FileSystem := String(Drive.FileSystem);

    if Info <> '' then Info := Info + #13#10 + #13#10;

    Info := Info +
      'Drive: ' + String(Drive.DeviceID) + #13#10 +
      'Label: ' + VolumeName + #13#10 +
      'FileSystem: ' + FileSystem + #13#10 +
      'Size: ' + FormatGB(TotalGBInt) + ' GB' + #13#10 +
      'FreeSpace: ' + FormatGB(FreeGBInt) + ' GB';
  end;

  Result := Info;
end;

// ------------------- Инициализация мастера -------------------
procedure InitializeWizard();
begin
  // Создаем страницу
  Page := CreateCustomPage(wpWelcome, 'System Information', 'The following information was gathered:');

  // Создаем Memo
  Memo := TNewMemo.Create(Page);
  Memo.Parent := Page.Surface;
  Memo.Left := 0;
  Memo.Top := 0;
  Memo.Width := Page.SurfaceWidth;
  Memo.Height := Page.SurfaceHeight;
  Memo.ParentColor := True;
  Memo.WordWrap := True;
  Memo.ReadOnly := True;
  Memo.ScrollBars := ssVertical; // вертикальная прокрутка
  Memo.Clear;

  // Добавляем информацию в Memo по отдельности
  Memo.Lines.Add('--- CPU ---');
  Memo.Lines.Add(GetCPUInfo());
  Memo.Lines.Add('');

  Memo.Lines.Add('--- RAM ---');
  Memo.Lines.Add(GetRAMInfo());
  Memo.Lines.Add('');

  Memo.Lines.Add('--- Motherboard ---');
  Memo.Lines.Add(GetMotherboard());
  Memo.Lines.Add('');

  Memo.Lines.Add('--- GPU ---');
  Memo.Lines.Add(GetGPUInfo());
  Memo.Lines.Add('');

  Memo.Lines.Add('--- Sound Devices ---');
  Memo.Lines.Add(GetSoundInfo());
  Memo.Lines.Add('');

  Memo.Lines.Add('--- Operating System ---');
  Memo.Lines.Add(GetOSInfo());
  Memo.Lines.Add('');

  Memo.Lines.Add('--- Drives ---');
  Memo.Lines.Add(GetDrivesInfo());
  Memo.Lines.Add('');
end;
[/SPOILER]

Crachlow · Вчера в 14:30

Т.к. microsoft вообще отказалось от wmi и все делается через powershell, то с vga вообще проблемы. Через реестр не получить, в powershell то же самое. определяет первый набор банок, но все же можно по названию карты, хотя то же сомнительно, но так же через реестр, карта возможно будет одна а памяти в разных вариациях :acute:

ROMKA-1977 · Вчера в 14:51

Может существует современная внешняя dll для подключения к Inno Setup ? Перепробовал всё что нашёл: ISab.dll, ISSysInfo.dll, isUtils.dll, ISSysInfo.dll, ISWMI.dll, SysInfo.dll, Victor Dobrov. Все с определением памяти VGA нормально не работает.

Crachlow · Вчера в 14:54

в данный момент пока нет, все они используют wmi

ROMKA-1977 · Вчера в 15:00

А что по моему примеру всё ли правильно выполнил и есть ли что исправлять ? Если не лень проверить.

Crachlow · Вчера в 15:50

Get-WmiObject устарел, но вот Get-CimInstance пока будет действовать.

ROMKA-1977 написал(а):
Если не лень проверить

что значит проверить? оно и так работает, но vram будет определятся для новых карт, начиная с 1000 серии или аналог amd, не правильно. Будет видна только часть памяти.

Проблема Определение памяти VGA

ROMKA-1977

Новичок

Crachlow

Старожил

ROMKA-1977

Новичок

Crachlow

Старожил

ROMKA-1977

Новичок

Crachlow

Старожил