utils/uutlSystemInfo.pas

unit uutlSystemInfo;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit enthält Klassen zum Auslesen von System Informationen (CPU, Grafikkarte, OpenGL) }

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, uutlGenerics
  {$IFDEF WINDOWS}, ActiveX, ComObj, variants {$ENDIF};

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlSystemInfo = class;
  TutlSystemInfoList = specialize TutlList<TutlSystemInfo>;
  TutlSystemInfo = class(TObject)
  private
    fName: String;
    fValue: String;
    fItems: TutlSystemInfoList;
    function GetCount: Integer;
    function GetItems(const aIndex: Integer): TutlSystemInfo;
  public
    property Name:  String  read fName;
    property Value: String  read fValue;
    property Count: Integer read GetCount;
    property Items[const aIndex: Integer]: TutlSystemInfo read GetItems; default;

    procedure Update; virtual;
    function ToString: String; override;

    constructor Create; virtual;
    destructor Destroy; override;
  end;
  TutlSystemInfoClass = class of TutlSystemInfo;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlOpenGLInfo = class(TutlSystemInfo)
  public
    procedure Update; override;
  end;

  {$IFDEF WINDOWS}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlWmiSystemInfo = class(TutlSystemInfo)
  protected type
    TStringArr = array of String;
  protected
    function GetComputer: String; virtual;
    function GetNamespace: String; virtual;
    function GetUsername: String; virtual;
    function GetPassword: String; virtual;
    function GetQuery: String; virtual;
    function GetProperties: TStringArr; virtual;
    function GetSubItemName(const aIndex: Integer): String; virtual;
  public
    procedure Update; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlProcessorInfo = class(TutlWmiSystemInfo)
  private const
    PROCESSOR_PROPERTIES: array[0..11] of String = ('AddressWidth', 'Caption',
      'CurrentClockSpeed', 'Description', 'ExtClock', 'Family', 'Manufacturer',
      'MaxClockSpeed', 'Name', 'NumberOfCores', 'NumberOfLogicalProcessors',
      'Version');
  protected
    function GetQuery: String; override;
    function GetProperties: TStringArr; override;
    function GetSubItemName(const aIndex: Integer): String; override;
  public
    procedure Update; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlVideoControllerInfo = class(TutlWmiSystemInfo)
  private const
    VIDEO_CONTROLLER_PROPERTIES: array[0..11] of String = ('AdapterRAM', 'Caption',
      'CurrentBitsPerPixel', 'CurrentHorizontalResolution', 'CurrentRefreshRate',
      'CurrentScanMode', 'CurrentVerticalResolution', 'Description', 'DriverDate',
      'DriverVersion', 'Name', 'VideoProcessor');
  protected
    function GetQuery: String; override;
    function GetProperties: TStringArr; override;
    function GetSubItemName(const aIndex: Integer): String; override;
  public
    procedure Update; override;
  end;
  {$ENDIF}

procedure LogSystemInfo(const aClass: TutlSystemInfoClass);

const
  SYTEM_INFO_CLASSES_COUNT = {$IFDEF WINDOWS}2+{$ENDIF}1;
  SYTEM_INFO_CLASSES: array[0..SYTEM_INFO_CLASSES_COUNT-1] of TutlSystemInfoClass = (
    {$IFDEF WINDOWS}TutlProcessorInfo,
    TutlVideoControllerInfo,{$ENDIF}
    TutlOpenGLInfo);

implementation

uses
  uutlExceptions, math, dglOpenGL, uutlLogger;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CreateItem(const aName, aValue: String): TutlSystemInfo;
begin
  result := TutlSystemInfo.Create;
  result.fName  := aName;
  result.fValue := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function VariantToStr(const aVariant: Variant): String;
begin
  result := '';
  if (TVarData(aVariant).vtype <> varempty) and
     (TVarData(aVariant).vtype <> varnull) and
     (TVarData(aVariant).vtype <> varerror) then begin
    result := aVariant;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure LogSystemInfo(const aClass: TutlSystemInfoClass);
var
  info: TutlSystemInfo;
  sList: TStringList;
  i: Integer;
begin
  info  := aClass.Create;
  sList := TStringList.Create;
  try try
    info.Update;
    sList.Text := info.ToString;
    for i := 0 to sList.Count-1 do
      utlLogger.Log('SystemInfo', sList[i], []);
  except on e: Exception do
    utlLogger.Error('SystemInfo', 'Error while logging system info: %s', [e.Message]);
  end;
  finally
    FreeAndNil(info);
    FreeAndNil(sList);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSystemInfo////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSystemInfo.GetCount: Integer;
begin
  result := fItems.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSystemInfo.GetItems(const aIndex: Integer): TutlSystemInfo;
begin
  if (aIndex >= 0) and (aIndex < fItems.Count) then
    result := fItems[aIndex]
  else
    raise EOutOfRange.Create(aIndex, 0, fItems.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSystemInfo.Update;
begin
//DUMMY
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSystemInfo.ToString: String;
var
  str: String;

  procedure FillStr(var aStr: String; const aLen: Integer; const aChar: Char = ' ');
  begin
    while (Length(aStr) < aLen) do
      aStr := aStr + aChar;
  end;

  procedure WriteItem(const aPrefix: String; const aItem: TutlSystemInfo; const aItemLen: Integer);
  var
    len, i: Integer;
    line: String;
  begin
    line := aItem.Name + ':';
    if (aItem.Count = 0) then begin
      line := line;
      FillStr(line, aItemLen + 2);
      line := line + aItem.Value;
    end;
    str := str + aPrefix + line + sLineBreak;
    if (aItem.Count > 0) then begin
      len := 0;
      for i := 0 to aItem.Count-1 do
        len := max(len, Length(aItem[i].Name));
      for i := 0 to aItem.Count-1 do
        WriteItem(aPrefix+'  ', aItem[i], len);
    end;
  end;

begin
  str := '';
  WriteItem('', self, 0);
  result := str;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlSystemInfo.Create;
begin
  inherited Create;
  fName  := '';
  fValue := '';
  fItems := TutlSystemInfoList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlSystemInfo.Destroy;
begin
  FreeAndNil(fItems);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlOpenGLInfo////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlOpenGLInfo.Update;

  function AddItem(const aParent: TutlSystemInfo; const aName, aValue: String): TutlSystemInfo;
  begin
    result := CreateItem(aName, aValue);
    aParent.fItems.Add(result);
  end;

  function GetInteger(const aName: GLenum): String;
  var
    i: GLint;
  begin
    i := 0;
    glGetIntegerv(aName, @i);
    result := IntToStr(i);
  end;

var
  item: TutlSystemInfo;
begin
  inherited Update;
  fName  := 'OpenGL Information';
  fValue := '';
  item := AddItem(self, 'ImplementationBasics', '');
  AddItem(item, 'GL_VENDOR',                   glGetString(GL_VENDOR));
  AddItem(item, 'GL_RENDER',                   glGetString(GL_RENDER));
  AddItem(item, 'GL_VERSION',                  glGetString(GL_VERSION));
  AddItem(item, 'GL_SHADING_LANGUAGE_VERSION', glGetString(GL_SHADING_LANGUAGE_VERSION));

  item := AddItem(self, 'Basics', '');
  AddItem(item, 'GL_MAX_VIEWPORT_DIMS',            GetInteger(GL_MAX_VIEWPORT_DIMS));
  AddItem(item, 'GL_MAX_LIGHTS',                   GetInteger(GL_MAX_LIGHTS));
  AddItem(item, 'GL_MAX_CLIP_PLANES',              GetInteger(GL_MAX_CLIP_PLANES));
  AddItem(item, 'GL_MAX_MODELVIEW_STACK_DEPTH',    GetInteger(GL_MAX_MODELVIEW_STACK_DEPTH));
  AddItem(item, 'GL_MAX_PROJECTION_STACK_DEPTH',   GetInteger(GL_MAX_PROJECTION_STACK_DEPTH));
  AddItem(item, 'GL_MAX_TEXTURE_STACK_DEPTH',      GetInteger(GL_MAX_TEXTURE_STACK_DEPTH));
  AddItem(item, 'GL_MAX_ATTRIB_STACK_DEPTH',       GetInteger(GL_MAX_ATTRIB_STACK_DEPTH));
  AddItem(item, 'GL_MAX_COLOR_MATRIX_STACK_DEPTH', GetInteger(GL_MAX_COLOR_MATRIX_STACK_DEPTH));
  AddItem(item, 'GL_MAX_LIST_NESTING',             GetInteger(GL_MAX_LIST_NESTING));
  AddItem(item, 'GL_SUBPIXEL_BITS',                GetInteger(GL_SUBPIXEL_BITS));
  AddItem(item, 'GL_MAX_ELEMENTS_INDICES',         GetInteger(GL_MAX_ELEMENTS_INDICES));
  AddItem(item, 'GL_MAX_ELEMENTS_VERTICES',        GetInteger(GL_MAX_ELEMENTS_VERTICES));
  AddItem(item, 'GL_MAX_TEXTURE_UNITS',            GetInteger(GL_MAX_TEXTURE_UNITS));
  AddItem(item, 'GL_MAX_TEXTURE_COORDS',           GetInteger(GL_MAX_TEXTURE_COORDS));
  AddItem(item, 'GL_MAX_SAMPLE_MASK_WORDS',        GetInteger(GL_MAX_SAMPLE_MASK_WORDS));
  AddItem(item, 'GL_MAX_COLOR_TEXTURE_SAMPLES',    GetInteger(GL_MAX_COLOR_TEXTURE_SAMPLES));
  AddItem(item, 'GL_MAX_DEPTH_TEXTURE_SAMPLES',    GetInteger(GL_MAX_DEPTH_TEXTURE_SAMPLES));
  AddItem(item, 'GL_MAX_INTEGER_SAMPLES',          GetInteger(GL_MAX_INTEGER_SAMPLES));

  item := AddItem(self, 'Textures', '');
  AddItem(item, 'GL_MAX_TEXTURE_SIZE',           GetInteger(GL_MAX_TEXTURE_SIZE));
  AddItem(item, 'GL_MAX_3D_TEXTURE_SIZE',        GetInteger(GL_MAX_3D_TEXTURE_SIZE));
  AddItem(item, 'GL_MAX_CUBE_MAP_TEXTURE_SIZE',  GetInteger(GL_MAX_CUBE_MAP_TEXTURE_SIZE));
  AddItem(item, 'GL_MAX_TEXTURE_LOD_BIAS',       GetInteger(GL_MAX_TEXTURE_LOD_BIAS));
  AddItem(item, 'GL_MAX_ARRAY_TEXTURE_LAYERS',   GetInteger(GL_MAX_ARRAY_TEXTURE_LAYERS));
  AddItem(item, 'GL_MAX_TEXTURE_BUFFER_SIZE',    GetInteger(GL_MAX_TEXTURE_BUFFER_SIZE));
  AddItem(item, 'GL_MAX_RECTANGLE_TEXTURE_SIZE', GetInteger(GL_MAX_RECTANGLE_TEXTURE_SIZE));
  AddItem(item, 'GL_MAX_RENDERBUFFER_SIZE',      GetInteger(GL_MAX_RENDERBUFFER_SIZE));

  item := AddItem(self, 'FrameBuffers', '');
  AddItem(item, 'GL_MAX_DRAW_BUFFERS',      GetInteger(GL_MAX_DRAW_BUFFERS));
  AddItem(item, 'GL_MAX_COLOR_ATTACHMENTS', GetInteger(GL_MAX_COLOR_ATTACHMENTS));
  AddItem(item, 'GL_MAX_SAMPLES',           GetInteger(GL_MAX_SAMPLES));

  item := AddItem(self, 'VertexShaderLimits', '');
  AddItem(item, 'GL_MAX_VERTEX_ATTRIBS',             GetInteger(GL_MAX_VERTEX_ATTRIBS));
  AddItem(item, 'GL_MAX_VERTEX_UNIFORM_COMPONENTS',  GetInteger(GL_MAX_VERTEX_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_VERTEX_UNIFORM_VECTORS',     GetInteger(GL_MAX_VERTEX_UNIFORM_VECTORS));
  AddItem(item, 'GL_MAX_VERTEX_UNIFORM_BLOCKS',      GetInteger(GL_MAX_VERTEX_UNIFORM_BLOCKS));
  AddItem(item, 'GL_MAX_VERTEX_OUTPUT_COMPONENTS',   GetInteger(GL_MAX_VERTEX_OUTPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS', GetInteger(GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS));

  item := AddItem(self, 'FragmentShaderLimits', '');
  AddItem(item, 'GL_MAX_FRAGMENT_UNIFORM_COMPONENTS',   GetInteger(GL_MAX_FRAGMENT_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_FRAGMENT_UNIFORM_VECTORS',      GetInteger(GL_MAX_FRAGMENT_UNIFORM_VECTORS));
  AddItem(item, 'GL_MAX_FRAGMENT_UNIFORM_BLOCKS',       GetInteger(GL_MAX_FRAGMENT_UNIFORM_BLOCKS));
  AddItem(item, 'GL_MAX_FRAGMENT_INPUT_COMPONENTS',     GetInteger(GL_MAX_FRAGMENT_INPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_IMAGE_UNITS',                   GetInteger(GL_MAX_IMAGE_UNITS));
  AddItem(item, 'GL_MAX_FRAGMENT_IMAGE_UNIFORMS',       GetInteger(GL_MAX_FRAGMENT_IMAGE_UNIFORMS));
  AddItem(item, 'GL_MIN_PROGRAM_TEXEL_OFFSET',          GetInteger(GL_MIN_PROGRAM_TEXEL_OFFSET));
  AddItem(item, 'GL_MAX_PROGRAM_TEXEL_OFFSET',          GetInteger(GL_MAX_PROGRAM_TEXEL_OFFSET));
  AddItem(item, 'GL_MIN_PROGRAM_TEXTURE_GATHER_OFFSET', GetInteger(GL_MIN_PROGRAM_TEXTURE_GATHER_OFFSET));
  AddItem(item, 'GL_MAX_PROGRAM_TEXTURE_GATHER_OFFSET', GetInteger(GL_MAX_PROGRAM_TEXTURE_GATHER_OFFSET));

  item := AddItem(self, 'CombinedFragmentAndVertexShaderLimits', '');
  AddItem(item, 'GL_MAX_UNIFORM_BUFFER_BINDINGS',                     GetInteger(GL_MAX_UNIFORM_BUFFER_BINDINGS));
  AddItem(item, 'GL_MAX_UNIFORM_BLOCK_SIZE',                          GetInteger(GL_MAX_UNIFORM_BLOCK_SIZE));
  AddItem(item, 'GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT',                 GetInteger(GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT));
  AddItem(item, 'GL_MAX_COMBINED_UNIFORM_BLOCKS',                     GetInteger(GL_MAX_COMBINED_UNIFORM_BLOCKS));
  AddItem(item, 'GL_MAX_VARYING_FLOATS',                              GetInteger(GL_MAX_VARYING_FLOATS));
  AddItem(item, 'GL_MAX_VARYING_COMPONENTS',                          GetInteger(GL_MAX_VARYING_COMPONENTS));
  AddItem(item, 'GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS',                GetInteger(GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS));
  AddItem(item, 'GL_MAX_SUBROUTINES',                                 GetInteger(GL_MAX_SUBROUTINES));
  AddItem(item, 'GL_MAX_SUBROUTINE_UNIFORM_LOCATIONS',                GetInteger(GL_MAX_SUBROUTINE_UNIFORM_LOCATIONS));
  AddItem(item, 'GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS',          GetInteger(GL_MAX_COMBINED_VERTEX_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS',        GetInteger(GL_MAX_COMBINED_FRAGMENT_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_COMBINED_GEOMETRY_UNIFORM_COMPONENTS',        GetInteger(GL_MAX_COMBINED_GEOMETRY_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_COMBINED_TESS_CONTROL_UNIFORM_COMPONENTS',    GetInteger(GL_MAX_COMBINED_TESS_CONTROL_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_COMBINED_TESS_EVALUATION_UNIFORM_COMPONENTS', GetInteger(GL_MAX_COMBINED_TESS_EVALUATION_UNIFORM_COMPONENTS));

  item := AddItem(self, 'GeometryShaderLimits', '');
  AddItem(item, 'GL_MAX_GEOMETRY_UNIFORM_BLOCKS',          GetInteger(GL_MAX_GEOMETRY_UNIFORM_BLOCKS));
  AddItem(item, 'GL_MAX_GEOMETRY_INPUT_COMPONENTS',        GetInteger(GL_MAX_GEOMETRY_INPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_GEOMETRY_OUTPUT_COMPONENTS',       GetInteger(GL_MAX_GEOMETRY_OUTPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_GEOMETRY_OUTPUT_VERTICES',         GetInteger(GL_MAX_GEOMETRY_OUTPUT_VERTICES));
  AddItem(item, 'GL_MAX_GEOMETRY_TOTAL_OUTPUT_COMPONENTS', GetInteger(GL_MAX_GEOMETRY_TOTAL_OUTPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_GEOMETRY_TEXTURE_IMAGE_UNITS',     GetInteger(GL_MAX_GEOMETRY_TEXTURE_IMAGE_UNITS));
  AddItem(item, 'GL_MAX_GEOMETRY_SHADER_INVOCATIONS',      GetInteger(GL_MAX_GEOMETRY_SHADER_INVOCATIONS));

  item := AddItem(self, 'TesselationShaderLimits', '');
  AddItem(item, 'GL_MAX_TESS_GEN_LEVEL',                       GetInteger(GL_MAX_TESS_GEN_LEVEL));
  AddItem(item, 'GL_MAX_PATCH_VERTICES',                       GetInteger(GL_MAX_PATCH_VERTICES));
  AddItem(item, 'GL_MAX_TESS_PATCH_COMPONENTS',                GetInteger(GL_MAX_TESS_PATCH_COMPONENTS));
  AddItem(item, 'GL_MAX_TESS_CONTROL_UNIFORM_COMPONENTS',      GetInteger(GL_MAX_TESS_CONTROL_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_TESS_CONTROL_UNIFORM_BLOCKS',          GetInteger(GL_MAX_TESS_CONTROL_UNIFORM_BLOCKS));
  AddItem(item, 'GL_MAX_TESS_CONTROL_TEXTURE_IMAGE_UNITS',     GetInteger(GL_MAX_TESS_CONTROL_TEXTURE_IMAGE_UNITS));
  AddItem(item, 'GL_MAX_TESS_CONTROL_TOTAL_OUTPUT_COMPONENTS', GetInteger(GL_MAX_TESS_CONTROL_TOTAL_OUTPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_TESS_CONTROL_INPUT_COMPONENTS',        GetInteger(GL_MAX_TESS_CONTROL_INPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_TESS_CONTROL_OUTPUT_COMPONENTS',       GetInteger(GL_MAX_TESS_CONTROL_OUTPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_TESS_EVALUATION_UNIFORM_COMPONENTS',   GetInteger(GL_MAX_TESS_EVALUATION_UNIFORM_COMPONENTS));
  AddItem(item, 'GL_MAX_TESS_EVALUATION_UNIFORM_BLOCKS',       GetInteger(GL_MAX_TESS_EVALUATION_UNIFORM_BLOCKS));
  AddItem(item, 'GL_MAX_TESS_EVALUATION_TEXTURE_IMAGE_UNITS',  GetInteger(GL_MAX_TESS_EVALUATION_TEXTURE_IMAGE_UNITS));
  AddItem(item, 'GL_MAX_TESS_EVALUATION_OUTPUT_COMPONENTS',    GetInteger(GL_MAX_TESS_EVALUATION_OUTPUT_COMPONENTS));
  AddItem(item, 'GL_MAX_TESS_EVALUATION_INPUT_COMPONENTS',     GetInteger(GL_MAX_TESS_EVALUATION_INPUT_COMPONENTS));

  item := AddItem(self, 'TransformFeedbackShaderLimits', '');
  AddItem(item, 'GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS', GetInteger(GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS));
  AddItem(item, 'GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS',       GetInteger(GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS));
  AddItem(item, 'GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS',    GetInteger(GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS));
  AddItem(item, 'GL_MAX_TRANSFORM_FEEDBACK_BUFFERS',                GetInteger(GL_MAX_TRANSFORM_FEEDBACK_BUFFERS));
end;

{$IFDEF WINDOWS}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWmiSystemInfo/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWmiSystemInfo.GetComputer: String;
begin
  result := 'localhost'#0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWmiSystemInfo.GetNamespace: String;
begin
  result := 'root\CIMV2'#0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWmiSystemInfo.GetUsername: String;
begin
  result := #0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWmiSystemInfo.GetPassword: String;
begin
  result := #0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWmiSystemInfo.GetQuery: String;
begin
  result := #0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWmiSystemInfo.GetProperties: TStringArr;
begin
  SetLength(result, 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWmiSystemInfo.GetSubItemName(const aIndex: Integer): String;
begin
  result := IntToStr(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWmiSystemInfo.Update;
var
  SWbemLocator: OLEVariant;
  WMIService: OLEVariant;
  WbemObjectSet, WbemObject: OLEVariant;
  s: Variant;
  pCeltFetched: LongWord;
  oEnum: IEnumvariant;
  i, j: Integer;
  properties: TStringArr;
  item: TutlSystemInfo;

  computer: Variant;
  namespace: Variant;
  username: Variant;
  password: Variant;
  query: Variant;
const
  WBEM_FLAGFORWARDONLY = $00000020;
begin
  inherited Update;
  fItems.Clear;
  CoInitialize(nil);
  SWbemLocator  := CreateOleObject('WbemScripting.SWbemLocator');
  //WMIService    := SWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  computer  := GetComputer;
  namespace := GetNamespace;
  username  := GetUsername;
  password  := GetPassword;
  query     := GetQuery;
  WMIService    := SWbemLocator.ConnectServer(computer, namespace, username, password);
  WbemObjectSet := WMIService.ExecQuery(query, 'WQL', WBEM_FLAGFORWARDONLY);
  oEnum         := IUnknown(WbemObjectSet._NewEnum) as IEnumVariant;
  i             := 0;
  properties    := GetProperties;
  while oEnum.Next(1, WbemObject, pCeltFetched) = 0 do begin
    inc(i);
    item := TutlSystemInfo.Create;
    item.fName := GetSubItemName(i);
    fItems.Add(item);
    for j := low(properties) to high(properties) do begin
      s := properties[j];
      item.fItems.Add(CreateItem(
        properties[j],
        VariantToStr(WbemObject.Properties_.Item(s).Value)));
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlProcessorInfo/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlProcessorInfo.GetQuery: String;
begin
  result := 'SELECT * FROM Win32_Processor'#0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlProcessorInfo.GetProperties: TStringArr;
var
  i: Integer;
begin
  SetLength(result, Length(PROCESSOR_PROPERTIES));
  for i := low(result) to high(result) do
    result[i] := PROCESSOR_PROPERTIES[i];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlProcessorInfo.GetSubItemName(const aIndex: Integer): String;
begin
  result := format('Processor %d', [aIndex]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlProcessorInfo.Update;
begin
  fName  := 'Processor Information';
  fValue := '';
  inherited Update;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlVideoControllerInfo.GetQuery: String;
begin
  Result := 'SELECT * FROM Win32_VideoController';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlVideoControllerInfo.GetProperties: TStringArr;
var
  i: Integer;
begin
  SetLength(result, Length(VIDEO_CONTROLLER_PROPERTIES));
  for i := low(result) to high(result) do
    result[i] := VIDEO_CONTROLLER_PROPERTIES[i];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlVideoControllerInfo.GetSubItemName(const aIndex: Integer): String;
begin
  Result := format('Video Controller %d', [aIndex]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlVideoControllerInfo.Update;
begin
  fName  := 'Video Controller Information';
  fValue := '';
  inherited Update;
end;
{$ENDIF}

end.