{*******************************************************}
{                                                       }
{       Tocsg.WMI                                        }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.WMI;

interface

uses
  System.Classes, System.SysUtils, Winapi.Windows,
  Tocsg.Thread, EM.WbemScripting_TLB;

const
  WMI_ROOT_OBJECT = 'root\cimv2';
  KBYTE = Sizeof(Byte) shl 10;
  MBYTE = KBYTE        shl 10;
  GBYTE = MBYTE        shl 10;

  WBEM_INFINITE = $FFFFFFFF;
  WMI_SERVICE_NAME = 'Winmgmt';

  WMI_EVENT_CREATE = 2084146945;
  WMI_EVENT_MODIFY = 1531267689;
  WMI_EVENT_DELETE = 2121895681;

type
  TWMIEventKind = (wkUnknown, wkCreate, wkDelete, wkModify);
  TWMINotifyEvent = procedure(Sender: TObject; WMIEventKind: TWMIEventKind;
                              ovEvent: OleVariant) of object;
  TTgWmiEventThread = class(TTgThread)
  private
    bInit_,
    bSync_: Boolean;
    sWMIClass_: String;
    ovEvent_: OleVariant;
    WMIEventKind_: TWMIEventKind;
    WbemLocator_: TSWbemLocator;
    WbemEvent_: ISWbemEventSource;
    evWMINotify_: TWMINotifyEvent;
    procedure DoWMIEvent;
  protected
    procedure Execute; override;
  public
    Constructor Create(const sWMIClass: String; bSync: Boolean = true);
    Destructor Destroy; override;

    property OnWMINotify: TWMINotifyEvent write evWMINotify_;
  end;

type
  T2DimStrArray = array of array of string;

function WMI_GetPropertyString(WbemProperty: ISWbemProperty): String;
function WMI_GetSingleInstance(const sArg, sProp: String; var sResult: String): Boolean;
function WMI_GetSingleInstanceProperty(const sArg, sProp: String; var sResult: String): Boolean;
function WMI_GetInformationEx(const sCom, sNameSapce, sUser, sPass, sArg: String;
                             var wmiResults: T2DimStrArray; var nInstances: Integer): Boolean;
function WMI_GetPropertyIndex(wmiResults: T2DimStrArray; const sProp: String): Integer;
function WMI_GetPropertyData(wmiResults: T2DimStrArray; const sProp: String; nLine: Integer = 0): String;
function WMI_ConvWMIDateToDateTime(const sWmiDate: String; var nUTCOffset: Integer): TDateTime;

function WMI_GetTableInfo(const sTable, sField: String): String;

function WMI_GetOSInfo(const sField: String): String;
function WMI_GetOSInstallDateTime: TDateTime;

function WMI_GetCpuInfo: String;

function WMI_GetBaseboardInfo: String;
function WMI_GetMotherboardInfo: String;

function WMI_GetBiosInfo(const sField: String): String;
function WMI_GetBiosReleaseDateTime: TDateTime;
function WMI_GetBiosVersion: String;
function WMI_GetVideoController: String;
function WMI_GetNetworkTotalTraffic: LONGLONG;
function WMI_GetMemory: LONGLONG;
function WMI_GetMonitor: String;

implementation

uses
  Tocsg.Exception, Tocsg.Hash, Tocsg.Service, Tocsg.Safe, Tocsg.Trace,
  Winapi.ActiveX, System.Win.ComObj, System.Variants, Tocsg.Strings;

{ TTgWmiEventThread }

Constructor TTgWmiEventThread.Create(const sWMIClass: String; bSync: Boolean = true);
begin
  Inherited Create;
  bSync_ := bSync;
  sWMIClass_ := QuotedStr(sWMIClass);
  WbemLocator_ := nil;
  ovEvent_ := 0;
  WbemEvent_ := nil;
  evWMINotify_ := nil;
end;

Destructor TTgWmiEventThread.Destroy;
begin
  evWMINotify_ := nil;
  FreeAndNil(WbemLocator_);
  Inherited;
end;

procedure TTgWmiEventThread.DoWMIEvent;
begin
  if Assigned(evWMINotify_) then
    evWMINotify_(Self, WMIEventKind_, ovEvent_);
end;

procedure TTgWmiEventThread.Execute;
var
  nReTryCnt: Integer;

  function InitWMI: Boolean;
  var
    WbemServices: ISWbemServices;
    sQuery: String;
  begin
    Result := false;
    nLastError_ := 0;

  // 알수없는 이유로... Create()에서 생성 안될거 생각해서 이렇게 변경
    if WbemLocator_ = nil then
      try
        WbemLocator_ := TSWbemLocator.Create(nil);
        WbemServices := WbemLocator_.ConnectServer('', WMI_ROOT_OBJECT, '', '', '', '', 0, nil)
      except
        WbemLocator_ := nil;
        exit;
      end;

    try
      if WbemServices = nil then
      begin
        nLastError_ := 1;
        _Trace('WMI.ConnectServer() .. Fail, Error = %d', [GetLastError]);
        exit;
      end;
      sQuery := Format('SELECT * FROM __InstanceOperationEvent WITHIN 1 ' +
                          'WHERE TargetInstance ISA %s', [sWMIClass_]);

      WbemEvent_ := WbemServices.ExecNotificationQuery(sQuery,
                                                       'WQL',
                                                       wbemFlagForwardOnly or wbemFlagReturnImmediately,
                                                       nil);
      if WbemEvent_ = nil then
      begin
        nLastError_ := 2;
        _Trace('WMISvc.ExecNotificationQuery() .. Fail, Error = %d', [GetLastError]);
        exit;
      end;
      Result := true;
    except
      on e: Exception do
      begin
        nLastError_ := 3;

        exit;
      end;
    end;
  end;

begin
  nReTryCnt := 0;

  CoInitialize(nil);

// 운영체제가 잠금 상태일 경우 실패할 수 있다. 성공할때까지 시도..
// 위 처럼 예외처리로 서비스 재실행을 이렇게 변경해봄 
  while not Terminated and not bWorkStop_ and not InitWMI do
  begin
    Inc(nReTryCnt);

    if nRetryCnt > 30 then
    begin
    // 10분동안 시도해서 안되면 서비스 재시작 하도록 수정 
      nReTryCnt := 0;

      _Trace('InitWMI() .. try 10 minute .. Class="%s"', [sWMIClass_]);
      ServiceStop(WMI_SERVICE_NAME);
      Sleep(30000);
      ServiceStart(WMI_SERVICE_NAME);
      Sleep(10000);
    end;

    Sleep(10000);
  end;

//  if InitWMI then
    while not Terminated and not bWorkStop_ and Assigned(WbemEvent_) do
    begin
      try
        ovEvent_ := WbemEvent_.NextEvent(5000{WBEM_INFINITE});

        case ConvStrToHash(ovEvent_.Path_.class) of
          WMI_EVENT_CREATE : WMIEventKind_ := wkCreate; // __InstanceCreationEvent
          WMI_EVENT_MODIFY : WMIEventKind_ := wkModify; // __InstanceModificationEvent
          WMI_EVENT_DELETE : WMIEventKind_ := wkDelete; // __InstanceDeletionEvent
          else continue;
        end;
        if bSync_ then
          Synchronize(DoWMIEvent)
        else
          DoWMIEvent;
      except
      // 이거 예외 찍게 하면 엄청 찍혀서.. 일단 막자 
//        on e: Exception do
//          ESunkException.TraceException(Self, e);
      end;
    end;
  CoUninitialize;
end;

{ Other }

function WMI_GetPropertyString(WbemProperty: ISWbemProperty): String;
var
  i: Integer;
begin
  Result := '';

  if VarIsNull(WbemProperty.Get_Value) then
    Result := 'NULL'
  else begin
    case WbemProperty.CIMType of
      wbemCimtypeSint8,
      wbemCimtypeUint8,
      wbemCimtypeSint16,
      wbemCimtypeUint16,
      wbemCimtypeSint32,
      wbemCimtypeUint32,
      wbemCimtypeSint64 :
      begin
        if VarIsArray(WbemProperty.Get_Value) then
        begin
          for i := 0 to VarArrayHighBound(WbemProperty.Get_Value, 1) do
          begin
            if i > 0 then
              Result := Result + '|';
            Result := Result + IntToStr(WbemProperty.Get_Value[i]);
          end;
        end else
          Result := IntToStr(WbemProperty.Get_Value);
      end;
      wbemCimtypeReal32, wbemCimtypeReal64 : result := FloatToStr (WbemProperty.Get_Value);
      wbemCimtypeBoolean : if WbemProperty.Get_Value then result := 'True' else result := 'False';
      wbemCimtypeString,
      wbemCimtypeUint64 :
      begin
        if VarIsArray(WbemProperty.Get_Value) then
        begin
          for i := 0 to VarArrayHighBound(WbemProperty.Get_Value, 1) do
          begin
            if i > 0 then
              Result := Result + '|';
            Result := Result + WbemProperty.Get_Value [i];
          end;
        end else
          Result := WbemProperty.Get_Value;
      end;
      wbemCimtypeDatetime  : Result := WbemProperty.Get_Value;
      wbemCimtypeReference : Result := WbemProperty.Get_Value;
      wbemCimtypeChar16    : Result := '<16-bit character>';
      wbemCimtypeObject    : Result := '<CIM Object>';
    end ;
  end;
end;

function WMI_GetSingleInstance(const sArg, sProp: String; var sResult: String): Boolean;
var
  WbemLocator: TSWbemLocator;
  WbemServices: ISWbemServices;
  WbemObject: ISWbemObject;
  WbemProperty: ISWbemProperty;
begin
  Result := false;

  sResult := '';
  Guard(WbemLocator, TSWbemLocator.Create(nil));
  try
    WbemServices := WbemLocator.ConnectServer('', WMI_ROOT_OBJECT, '', '',
                                              '', '', 0, nil);
    WbemObject := WbemServices.Get(sArg, 0, nil);
    WbemProperty := WbemObject.Properties_.Item(sProp, 0);

    if WbemProperty.Name <> sProp then
      exit;

    sResult := WMI_GetPropertyString(WbemProperty);

    if sResult <> 'NULL' then
      Result := true;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. WMI_GetSingleInstance()');
  end;
end;

function WMI_GetSingleInstanceProperty(const sArg, sProp: String; var sResult: String): Boolean;
var
  WbemLocator: TSWbemLocator;
  WbemServices: ISWbemServices;
  WbemObjectSet: ISWbemObjectSet;
  WbemObject: ISWbemObject;
  WbemProperty: ISWbemProperty;
  ovVar: OleVariant;
  dwValue: DWORD;
  enum: IEnumVariant;
  sInfo: String;
begin
  Result := false;

  sResult := '';
  VarClear(ovVar);
  Guard(WbemLocator, TSWbemLocator.Create(nil));
  try
    WbemServices := WbemLocator.ConnectServer('', WMI_ROOT_OBJECT, '', '',
                                              '', '', 0, nil);
    WbemObjectSet := WbemServices.ExecQuery(sArg, 'WQL',
                                            wbemFlagReturnImmediately, nil);

    enum := (WbemObjectSet._NewEnum) as IEnumVariant;
    while (enum.Next(1, ovVar, dwValue) = S_OK) do
    begin
      WbemObject := IUnknown(ovVar) as SWBemObject;
      WbemProperty := WbemObject.Properties_.Item(sProp, 0);
      if WbemProperty.Name = sProp then
      begin
        sInfo := WMI_GetPropertyString(WbemProperty);
        if sInfo <> 'NULL' then
          Result := true;

        SumString(sResult, sInfo, ', ');
      end;
      VarClear(ovVar);
    end;
  except
    on E: Exception do
    begin
      ETgException.TraceException(E, 'Fail .. WMI_GetSingleInstanceProperty()');
      VarClear(ovVar);
    end;
  end;
end;

function WMI_GetInformationEx(const sCom, sNameSapce, sUser, sPass, sArg: String;
                         var wmiResults: T2DimStrArray; var nInstances: Integer): Boolean;
var
  WbemLocator: TSWbemLocator;
  WbemServices: ISWbemServices;
  WbemObjectSet: ISWbemObjectSet;
  WbemObject: ISWbemObject;
  WbemPropertySet: ISWbemPropertySet;
  WbemProperty: ISWbemProperty;
  propEnum, Enum: IEnumVariant;
  ovVar1, ovVar2: OleVariant;
  lwValue: DWORD;
  sValue: String;
  nInst, nRow, nCnt: Integer;
  bDimmed: Boolean;
begin
  Result := true;

  nInstances := 0;
  SetLength(wmiResults, 0, 0);
  bDimmed := false;
  VarClear(ovVar1);
  VarClear(ovVar2);
  Guard(WbemLocator, TSWbemLocator.Create(nil));
  try
    WbemServices := WbemLocator.ConnectServer(sCom,
                                            sNameSapce,
                                            sUser,
                                            sPass,
                                            '', '', 0, nil);

    if Pos('SELECT', sArg) = 1 then
      WbemObjectSet := WbemServices.ExecQuery(sArg, 'WQL', wbemFlagReturnImmediately, nil)
    else
      WbemObjectSet := WbemServices.InstancesOf(sArg, wbemFlagReturnImmediately or
                                              wbemQueryFlagShallow, nil);
    nInstances := WbemObjectSet.Count;
    if nInstances = 0 then
      exit;

  // Replicate VBScript's "for each" construct
    Enum := (WbemObjectSet._NewEnum) as IEnumVariant;
    nInst := 0;
    while(Enum.Next (1, ovVar1, lwValue) = S_OK) do
    begin
      WbemObject := IUnknown(ovVar1) as SWBemObject;
      WbemPropertySet := WbemObject.Properties_;
      nCnt := WbemPropertySet.Count;
      if not bDimmed then
      begin
        SetLength(wmiResults, nInstances + 1, nCnt + 1);
        wmiResults[0, 0] := 'Instance';
        bDimmed := true;
      end ;
      propEnum := (WbemPropertySet._NewEnum) as IEnumVariant;
      Inc(nInst);
      nRow := 1;
      wmiResults[nInst, 0] := IntToStr(nInst);

    // Replicate VBScript's "for each" construct
      while (propEnum.Next(1, ovVar2, lwValue) = S_OK) do
      begin
        WbemProperty := IUnknown(ovVar2) as SWBemProperty;
        sValue := WMI_GetPropertyString(WbemProperty);
        if nInst = 1 then wmiResults[0, nRow] := WbemProperty.Name;
        wmiResults[nInst, nRow] := sValue;
        Inc(nRow);
        VarClear(ovVar2); // whomp them mem leaks
      end;
    end;
    VarClear (ovVar1); // whomp them mem leaks
  except
    on E: Exception do
    begin
      ETgException.TraceException(E, 'Fail .. WMI_GetInformationEx()');
      VarClear (ovVar1);
      VarClear (ovVar2);
      Result := false;
    end;
  end;
end;

function WMI_GetPropertyIndex(wmiResults: T2DimStrArray; const sProp: String): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to High(wmiResults[0]) do
  begin
    if wmiResults[0, i] = sProp then
    begin
      Result := i;
      exit;
    end;
  end;
end;

function WMI_GetPropertyData(wmiResults: T2DimStrArray; const sProp: String; nLine: Integer = 0): String;
var
  i: Integer;
begin
  Result := '';
  if (Length(wmiResults)-1) < (nLine+1) then
    exit;
  i := WMI_GetPropertyIndex(wmiResults, sProp);
  if i > 0 then Result := wmiResults[nLine+1, i];
end;

function WMI_ConvWMIDateToDateTime(const sWmiDate: String; var nUTCOffset: Integer): TDateTime;
Const
// 지정된 고정길이 25
  LEN_WMI_DATETIME = 25;

// yyyymmddhhnnss.zzzzzzsUUU  +60 means 60 mins of UTC time
// 20030709091030.686000+060
// 1234567890123456789012345
var
  yy, mm, dd,
  hh, nn, ss, zz: Integer;
  dt: TDateTime;

  function GetNum(nOffset, nLen: integer): Integer;
  var
    n: Integer;
  begin
    Val(Copy(sWmiDate, nOffset, nLen), Result, n);
  end;

begin
  Result := ERROR_SUCCESS;
  nUTCOffset := 0;

  if length(sWmiDate) <> LEN_WMI_DATETIME then
    exit;

  yy := GetNum(1, 4);
  mm := GetNum(5, 2);
  if (mm = 0) or (mm > 12) then
    exit;

  dd := GetNum(7, 2);
  if (dd = 0) or (dd > 31) then
    exit;

  if not TryEncodeDate(yy, mm, dd, result) then     // D6 and later
  begin
    Result := -1;
    exit;
  end;

  hh := GetNum(9, 2);
  nn := GetNum(11, 2);
  ss := GetNum(13, 2);
  zz := 0 ;
  if Length(sWmiDate) >= 18 then
    zz := GetNum(16, 3);

  if not TryEncodeTime(hh, nn, ss, zz, dt) then
    exit;   // D6 and later

  Result := Result + dt;
  nUTCOffset := GetNum(22, 4);
end;

function WMI_GetTableInfo(const sTable, sField: String): String;
begin
  try
    if not WMI_GetSingleInstanceProperty
        (
          Format('SELECT %s FROM %s', [sField, sTable]), sField, Result
        ) then TTgTrace.T('WMI_GetTableInfo .. Fail!!, Table = %s, Field = %s', [sTable, sField]);
  except
    on E: Exception do
      ETgException.TraceException(E, Format('Fail .. WMI_GetTableInfo() .. Table=%s, Field=%s', [sTable, sField]));
  end;
end;

function WMI_GetOSInfo(const sField: String): String;
begin
  Result := WMI_GetTableInfo('Win32_OperatingSystem', sField);
end;

function WMI_GetOSInstallDateTime: TDateTime;
var
  sWMIDate: String;
  nUTCOffset: Integer;
begin
  if WMI_GetSingleInstanceProperty('SELECT InstallDate FROM Win32_Registry', 'InstallDate', sWMIDate) then
    Result := WMI_ConvWMIDateToDateTime(sWMIDate, nUTCOffset)
  else
    TTgTrace.T('WMI_GetOSInstallDateTime .. Fail!!');
end;

function WMI_GetCpuInfo: String;
begin
  Result := WMI_GetTableInfo('Win32_Processor', 'Name');
end;

function WMI_GetBaseboardInfo: String;
begin
  Result := WMI_GetTableInfo('Win32_BaseBoard', 'Product');
end;

function WMI_GetMotherboardInfo: String;
begin
  Result := WMI_GetTableInfo('Win32_MotherboardDevice', 'Name');
end;

function WMI_GetBiosInfo(const sField: String): String;
begin
  Result := WMI_GetTableInfo('Win32_BIOS', sField);
end;

function WMI_GetBiosReleaseDateTime: TDateTime;
var
  nUTCOffset: Integer;
begin
  Result := WMI_ConvWMIDateToDateTime(WMI_GetBiosInfo('ReleaseDate'), nUTCOffset);
end;

function WMI_GetBiosVersion: String;
var
  nVerCnt: Integer;
  wmiResults: T2DimStrArray;
begin
  Result := '';
  if WMI_GetInformationEx('', WMI_ROOT_OBJECT, '', '', 'Win32_BIOS', wmiResults, nVerCnt) then
  begin
    if nVerCnt > 0 then
      Result := Format('%s v%s.%s', [WMI_GetPropertyData(wmiResults, 'SMBIOSBIOSVersion'),
                                     WMI_GetPropertyData(wmiResults, 'SMBIOSMajorVersion'),
                                     WMI_GetPropertyData(wmiResults, 'SMBIOSMinorVersion')]);
  end;
end;

function WMI_GetVideoController: String;
begin
  Result := WMI_GetTableInfo('Win32_VideoController', 'Name');
end;

function WMI_GetNetworkTotalTraffic: LONGLONG;
var
  nVerCnt: Integer;
  wmiResults: T2DimStrArray;
  i: Integer;
begin
  Result := -1;
  if WMI_GetInformationEx('', WMI_ROOT_OBJECT, '', '', 'Win32_PerfFormattedData_Tcpip_NetworkInterface', wmiResults, nVerCnt) then
  begin
    Result := 0;
    for i := 0 to nVerCnt - 1 do
      Inc(Result, StrToInt64Def(WMI_GetPropertyData(wmiResults, 'BytesTotalPersec', i), 0));
  end;
end;

function WMI_GetMemory: LONGLONG;
begin
  Result := StrToInt64Def(WMI_GetTableInfo('Win32_ComputerSystem', 'TotalPhysicalMemory'), 0);
end;

function VariantByteArrayToString(V: Variant): string;
var
  i, LowIdx, HighIdx: Integer;
  Ch: Integer;
begin
  Result := '';
  if VarIsArray(V) then
  begin
    LowIdx := VarArrayLowBound(V, 1);
    HighIdx := VarArrayHighBound(V, 1);
    for i := LowIdx to HighIdx do
    begin
      try
        // Null이나 비정상 값 방지
        Ch := VarAsType(VarArrayGet(V, [i]), varByte);
        if Ch > 0 then
          Result := Result + Chr(Ch);
      except
        // 오류 발생 시 무시
      end;
    end;
  end;
end;

function WMI_GetMonitor: String;
var
  SWbemLocator, SWbemServices, SWbemObjectSet, Item: OLEVariant;
  Enum: IEnumVariant;
  Value: Cardinal;
  V: Variant;
  Manufacturer, ProductCode: string;
begin
  Result := '';
  try
    SWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
    SWbemServices := SWbemLocator.ConnectServer('.', 'root\WMI');
    SWbemObjectSet := SWbemServices.ExecQuery('SELECT * FROM WmiMonitorID', 'WQL', 0);
    Enum := IEnumVariant(IUnknown(SWbemObjectSet._NewEnum));
    while Enum.Next(1, Item, Value) = 0 do
    begin
      // 제조사와 제품 코드는 byte 배열로 리턴됨
      ProductCode := VariantByteArrayToString(Item.Properties_.Item('UserFriendlyName').Value);
      if ProductCode <> '' then
      begin
        SumString(Result, ProductCode, ', ');
      end else begin
        Manufacturer := VariantByteArrayToString(Item.Properties_.Item('ManufacturerName').Value);
        ProductCode := VariantByteArrayToString(Item.Properties_.Item('ProductCodeID').Value);
  //      SumString(Result, Format('Manufacturer: %s, Product Code: %s', [Manufacturer, ProductCode]), ', ');
        SumString(Result, Manufacturer + ' ' + ProductCode, ', ');
      end;
      Item := Unassigned;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. WMI_GetMonitor()');
  end;
end;

end.