Manipulations avec WMI

Version Courte

// On créé un enumérateur
  vEnum := IUnknown(ASWbemObject.Properties_._NewEnum) as IEnumVariant;
  while vEnum.Next(1, vSWbemProperty, vCardinal) = 0 do
  begin
  ... // ici on accéde a chaque properties avec vSWbemProperty
  end;

Version complète

function SWbemObjectPropertiesToString(ASWbemObject: TSWbemObject): string;
var
  vSWbemProperty: TSWbemProperty; //olevariant
  vPropValueV: olevariant;
  vPropvalueS: string;
  vCardinal: cardinal;
  vEnum: IEnumvariant;
  vVT:   TVarType;
 
begin
  Result := '';
 
  vEnum := IUnknown(ASWbemObject.Properties_._NewEnum) as IEnumVariant;
  while vEnum.Next(1, vSWbemProperty, vCardinal) = 0 do
  begin
    vPropValueV := vSWbemProperty.Value;
    vVT         := VarType(vPropValueV);
    if vVT > varQWord then
      vPropValueS := format('Variant de type (%d)', [vVT])
    else
      vPropValueS := vartostrdef(vPropValueV, 'null');
    Result += vSWbemProperty.Name + ' = ' + vPropValueS + chr(13) + chr(10);
  end;
end;

Sources a étudier :

• https://delphi.developpez.com/faq/?page=Provider#Comment-recevoir-un-evenement-asynchrone-WMI

Source : https://www.phind.com/

Pour utiliser SWbemSink dans Free Pascal, vous devez d'abord créer une instance de l'objet SWbemSink. Ensuite, vous pouvez utiliser cette instance en tant que paramètre ObjWbemSink pour effectuer un appel asynchrone. Les événements de votre implémentation de SWbemSink sont déclenchés lorsque l'état ou les résultats sont retournés, ou lorsque l'appel est terminé [0].

Pour créer une instance de l'objet SWbemSink en Free Pascal, vous pouvez utiliser la méthode CreateComObject de la bibliothèque ActiveX fournie avec Free Pascal.
La méthode CreateComObject crée une instance d'un objet COM spécifié par son identificateur de classe (CLSID) et renvoie une interface pour cet objet.
Le code suivant crée une instance de l'objet SWbemSink en Free Pascal :

uses
  ActiveX;
 
var
  SWbemSink: Variant;
begin
  SWbemSink := CreateComObject('{75718C9A-F029-11d1-A1AC-00C04FB6C223}');
  // Utilisez SWbemSink comme paramètre ObjWbemSink pour effectuer un appel asynchrone.
end;

Ensuite, vous pouvez implémenter les événements de votre objet SWbemSink en utilisant des méthodes avec la signature appropriée. Par exemple, pour gérer l'événement OnObjectReady, vous pouvez créer une méthode avec la signature suivante :

procedure TMySWbemSink.OnObjectReady(const objWbemObject: IDispatch; const objWbemAsyncContext: IDispatch);
begin
  // Code pour gérer l'événement OnObjectReady.
end;

Enfin, vous pouvez associer votre instance SWbemSink à votre requête WMI en utilisant la propriété ObjectSink de votre objet SWbemServices. Le code suivant est un exemple de requête WMI qui utilise l'objet SWbemSink pour recevoir les résultats :

uses
  ActiveX, ComObj, Variants;
 
var
  SWbemLocator: Variant;
  SWbemServices: Variant;
  SWbemSink: Variant;
  SWbemObjectSet: Variant;
  SWbemObject: Variant;
  WQL: string;
begin
  // Initialisez COM.
  CoInitialize(nil);
 
  // Créez une instance de SWbemLocator et connectez-vous à l'ordinateur local.
  SWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  SWbemServices := SWbemLocator.ConnectServer('.', 'root\cimv2', '', '');
 
  // Créez une instance de SWbemSink.
  SWbemSink := CreateComObject('{75718C9A-F029-11d1-A1AC-00C04FB6C223}');
 
  // Associez SWbemSink à la requête WMI.
  SWbemServices.ObjectSink := SWbemSink;
 
  // Exécutez une requête WMI pour récupérer les noms des services.
  WQL := 'SELECT * FROM Win32_Service';
  SWbemObjectSet := SWbemServices.ExecQuery(WQL, 'WQL', wbemFlagForwardOnly or wbemFlagReturnImmediately);
 
  // Parcourez les résultats.
  while not VarIsNull(SWbemObjectSet) and (not SWbemObjectSet.atEndOfStream) do
  begin
    SWbemObject := SWbemObjectSet.NextObject;
    // Code pour traiter SWbemObject.
  end;
 
  // Libérez les objets COM.
  SWbemObjectSet := Unassigned;
  SWbemObject := Unassigned;
  SWbemSink := Unassigned;
  SWbemServices := Unassigned;
  SWbemLocator := Unassigned;
  CoUninitialize;
end;

En résumé, pour utiliser SWbemSink dans Free Pascal, vous devez créer une instance de l'objet SWbemSink en utilisant la méthode CreateComObject de la bibliothèque ActiveX. Ensuite, vous pouvez implémenter les événements de votre objet SWbemSink en utilisant des méthodes avec la signature appropriée. Enfin, vous pouvez associer votre instance SWbemSink à votre requête WMI en utilisant la propriété ObjectSink de votre objet SWbemServices.

//-----------------------------------------------------------------------------------------------------
//     This code was generated by the Wmi Delphi Code Creator (WDCC) Version 1.9.9.350
//     http://code.google.com/p/wmi-delphi-code-creator/
//     Blog http://theroadtodelphi.wordpress.com/wmi-delphi-code-creator/
//     Author Rodrigo Ruz V. (RRUZ) Copyright (C) 2011-2015
//----------------------------------------------------------------------------------------------------- 
//
//     LIABILITY DISCLAIMER
//     THIS GENERATED CODE IS DISTRIBUTED "AS IS". NO WARRANTY OF ANY KIND IS EXPRESSED OR IMPLIED.
//     YOU USE IT AT YOUR OWN RISK. THE AUTHOR NOT WILL BE LIABLE FOR DATA LOSS,
//     DAMAGES AND LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING OR MISUSING THIS CODE.
//
//----------------------------------------------------------------------------------------------------
program GetWMI_Info;
 
{$mode objfpc} {$H+}
 
uses
  Windows,
  Variants,
  SysUtils,
  ActiveX,
  JwaWbemCli;
 
const
  RPC_C_AUTHN_LEVEL_DEFAULT = 0;
  RPC_C_IMP_LEVEL_IMPERSONATE = 3;
  RPC_C_AUTHN_WINNT = 10;
  RPC_C_AUTHZ_NONE = 0;
  RPC_C_AUTHN_LEVEL_CALL = 3;
  EOAC_NONE = 0;
 
type
  TWmiEventSink = class(TInterfacedObject, IWbemObjectSink)
  public
    function Indicate(lObjectCount: Longint;  var apObjArray: IWbemClassObject): HRESULT; stdcall;
    function SetStatus(lFlags: Longint; hResult: HRESULT; strParam: WideString; pObjParam: IWbemClassObject): HRESULT; stdcall;
  end;
 
function TWmiEventSink.Indicate(lObjectCount: Longint; var apObjArray: IWbemClassObject): HRESULT; stdcall;
var
  Instance      : IWbemClassObject;
  pVal          : OleVariant;
  pType         : Integer;
  plFlavor      : Integer;
  lFlags        : Longint;
  sValue        : string;
begin
  Result := WBEM_S_NO_ERROR;
  lFlags :=0;
 
  if lObjectCount > 0 then
  begin
 
 
 
    if Succeeded(apObjArray.Get('TargetInstance', lFlags, pVal, pType, plFlavor)) then
    begin      
      Instance := IUnknown(pVal) as IWbemClassObject;
      try
 
      finally
        Instance := nil;
      end;	  
    end;
 
 
  end;
end;  
 
 
function TWmiEventSink.SetStatus(lFlags: Longint; hResult: HRESULT; strParam: WideString; pObjParam: IWbemClassObject): HRESULT; stdcall;
begin
  Result := WBEM_S_NO_ERROR;
end;
 
//detect when a key was pressed in the console window
function KeyPressed:Boolean;
var
  lpNumberOfEvents     : DWORD;
  lpBuffer             : TInputRecord;
  lpNumberOfEventsRead : DWORD;
  nStdHandle           : THandle;
begin
  Result:=false;
  nStdHandle := GetStdHandle(STD_INPUT_HANDLE);
  lpNumberOfEvents:=0;
  GetNumberOfConsoleInputEvents(nStdHandle,lpNumberOfEvents);
  if lpNumberOfEvents<> 0 then
  begin
    PeekConsoleInput(nStdHandle,lpBuffer,1,lpNumberOfEventsRead);
    if lpNumberOfEventsRead <> 0 then
    begin
      if lpBuffer.EventType = KEY_EVENT then
      begin
        if lpBuffer.Event.KeyEvent.bKeyDown then
          Result:=true
        else
          FlushConsoleInputBuffer(nStdHandle);
      end
      else
      FlushConsoleInputBuffer(nStdHandle);
    end;
  end;
end;
 
//Wmi async event
procedure Test_IWbemServices_ExecNotificationQueryAsync;
const
  strLocale    = '';
  strUser      = '';
  strPassword  = '';
  strNetworkResource = 'root\CIMV2';
  strAuthority       = '';
  WQL ='Select * From Win32_ProcessTrace Within 1 ';
 
var
  FWbemLocator         : IWbemLocator;
  FWbemServices        : IWbemServices;
  FUnsecuredApartment  : IUnsecuredApartment;
  ppStub               : IUnknown;
  FWmiEventSink        : TWmiEventSink;
  StubSink             : IWbemObjectSink;
 
begin
  // Set general COM security levels --------------------------
  // Note: If you are using Windows 2000, you need to specify -
  // the default authentication credentials for a user by using
  // a SOLE_AUTHENTICATION_LIST structure in the pAuthList ----
  // parameter of CoInitializeSecurity ------------------------
  if Failed(CoInitializeSecurity(nil, -1, nil, nil, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE, nil)) then Exit;
  // Obtain the initial locator to WMI -------------------------
  if Succeeded(CoCreateInstance(CLSID_WbemLocator, nil, CLSCTX_INPROC_SERVER, IID_IWbemLocator, FWbemLocator)) then
  try
    // Connect to WMI through the IWbemLocator::ConnectServer method
    if Succeeded(FWbemLocator.ConnectServer(strNetworkResource, strUser, strPassword, strLocale,  WBEM_FLAG_CONNECT_USE_MAX_WAIT, strAuthority, nil, FWbemServices)) then
    try
      // Set security levels on the proxy -------------------------
      if Failed(CoSetProxyBlanket(FWbemServices, RPC_C_AUTHN_WINNT, RPC_C_AUTHZ_NONE, nil, RPC_C_AUTHN_LEVEL_CALL, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE)) then Exit;
      if Succeeded(CoCreateInstance(CLSID_UnsecuredApartment, nil, CLSCTX_LOCAL_SERVER, IID_IUnsecuredApartment, FUnsecuredApartment)) then
      try
        FWmiEventSink := TWmiEventSink.Create;
        if Succeeded(FUnsecuredApartment.CreateObjectStub(FWmiEventSink, ppStub)) then
        try
          if Succeeded(ppStub.QueryInterface(IID_IWbemObjectSink, StubSink)) then
          try
            if Succeeded(FWbemServices.ExecNotificationQueryAsync('WQL', WQL, WBEM_FLAG_SEND_STATUS, nil, StubSink)) then
            begin
              Writeln('Listening events...Press any key to exit');
               while not KeyPressed do ;
              FWbemServices.CancelAsyncCall(StubSink);
            end;
          finally
            StubSink := nil;
          end;
        finally
          ppStub := nil;
        end;
      finally
        FUnsecuredApartment := nil;
      end;
    finally
      FWbemServices := nil;
    end;
  finally
    FWbemLocator := nil;
  end;
end;
 
begin
 try
  // Initialize COM
  if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
  try
    Test_IWbemServices_ExecNotificationQueryAsync;
  finally
    CoUninitialize();
  end;
 except 
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;  
  Readln;
 
end.