Différences

Ci-dessous, les différences entre deux révisions de la page.

--- prog:lazarus:cas:wmi:notes [26/03/2023 17:49]
thierry [Enumérer les properties d'un SWbemObject]
+++ prog:lazarus:cas:wmi:notes [01/04/2023 13:58] (Version actuelle)
thierry [Exemple généré avec Wmi Delphi Code Creator]
@@ Ligne 42: / Ligne 42: @@
 Sources a étudier :
   * [[https://delphi.developpez.com/faq/?page=Provider#Comment-recevoir-un-evenement-asynchrone-WMI]]
+==== Phind dit... ====
+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 :
+<code delphi>
+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;
+</code>
+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 :
+<code delphi>
+procedure TMySWbemSink.OnObjectReady(const objWbemObject: IDispatch; const objWbemAsyncContext: IDispatch);
+begin
+  // Code pour gérer l'événement OnObjectReady.
+end;
+</code>
+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 :
+<code delphi>
+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;
+</code>
+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.
+==== Exemple généré avec Wmi Delphi Code Creator ====
+<code delphi>
+//-----------------------------------------------------------------------------------------------------
+//     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.
+</code>
+Autres sources :
+  * [[https://github.com/RRUZ/wmi-delphi-code-creator/wiki/FPCDevelopers]]
+  * [[https://theroadtodelphi.com/2011/04/21/accesing-the-wmi-from-delphi-and-fpc-via-com-without-late-binding-or-wbemscripting_tlb/]]