Différences

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

--- prog:lazarus:cas:wmi:convfromdelphi [03/04/2023 17:24]
thierry [Adaptation du code]
+++ prog:lazarus:cas:wmi:convfromdelphi [03/04/2023 17:47] (Version actuelle)
thierry [Sources & Ressources]
@@ Ligne 1: / Ligne 1: @@
-====== Conversion depuis Delphi ======
+====== Conversion WbemScripting_TLB de Delphi vers Lazarus ======
 ===== Énoncé du problème =====
 Dans mes recherches j'ai trouvé du code **Delphi** faisant (a peu prés) ce que je cherche a faire.
@@ Ligne 12: / Ligne 12: @@
 Ci dessous nous allons trouver :
   - La source originale en Delphi que j'ai trouvé.
+  - Comment importer un TLB avec Lazarus
+  - La source corrigé en Free Pascal
 ===== Sources Delphi Originales =====
-<code delphi Delphi>
+<code delphi Delphi [enable_line_numbers="true"]>
 unit Unit1;
@@ Ligne 80: / Ligne 82: @@
 {{:prog:lazarus:cas:wmi:activx1.jpg?400|}}
+Plus d'infos ici : [[https://wiki.lazarus.freepascal.org/LazActiveX]]
 ==== Importer le TLB ====
 Cela nous donne accés a un nouveau menu ''Importer la bibliothèque de types...'' :
@@ Ligne 97: / Ligne 101: @@
 Exemple ''TSWbemSink'' est devenu  ''TEvsSWbemSink'' et ses properties ont changé:
-<code delphi Delphi>
+<code delphi Delphi [enable_line_numbers="true"]>
   TSWbemSink = class(TOleServer)
   private
@@ Ligne 126: / Ligne 130: @@
 </code>
-<code delphi Lazarus>
+<code delphi Lazarus [enable_line_numbers="true"]>
   TEvsSWbemSink = Class(TEventSink)
   Private
@@ Ligne 149: / Ligne 153: @@
 </code>
+==== Code Lazarus ====
+<code delphi [enable_line_numbers="true",highlight_lines_extra="14,25,29,30,53,55,57,60,61"]>
+unit Unit1;
+{$mode objfpc}{$H+}
+interface
+uses
+  ActiveX,
+  StdCtrls,
+  SysUtils,
+  Forms,
+  Controls,
+  Dialogs,
+  WbemScripting_1_2_TLB;
+type
+  { TForm1 }
+  TForm1 = class(TForm)
+    Button1: TButton;
+    Memo1:   TMemo;
+    procedure Button1Click(Sender: TObject);
+  private
+    FSink:     TEvsSWbemSink;
+    FLocator:  ISWbemLocator;
+    FServices: ISWbemServices;
+    procedure EventReceived(Sender: TObject; objWbemObject: ISWbemObject;
+      objWbemAsyncContext: ISWbemNamedValueSet);
+  public
+  end;
+var
+  Form1: TForm1;
+implementation
+{$R *.lfm}
+{ TForm1 }
+procedure TForm1.Button1Click(Sender: TObject);
+const
+  WQL = 'SELECT * FROM __InstanceCreationEvent WITHIN 1 WHERE TargetInstance ISA "Win32_Process"';
+begin
+  FLocator  := CoSWbemLocator.Create;
+  //Connect to the WMI service
+  FServices := FLocator.ConnectServer('.', 'root\cimv2', '', '', '',
+    '', wbemConnectFlagUseMaxWait, nil);
+  //create the sink instance
+  FSink     := TEvsSWbemSink.Create(self);
+  //assign the event handler
+  FSink.OnOnObjectReady := @EventReceived;
+  //Run the ExecNotificationQueryAsync
+  FServices.ExecNotificationQueryAsync(FSink.ComServer, WQL, 'WQL', 0, nil, nil);
+end;
+procedure TForm1.EventReceived(Sender: TObject; objWbemObject: ISWbemObject;
+  objWbemAsyncContext: ISWbemNamedValueSet);
+var
+  PropVal: olevariant;
+begin
+  PropVal := objWbemObject;
+  Memo1.Lines.Add(Format('Caption   : %s ', [PropVal.TargetInstance.Caption]));
+  Memo1.Lines.Add(Format('ProcessID : %s ', [PropVal.TargetInstance.ProcessID]));
+end;
+initialization
+  CoInitializeEx(nil, COINIT_MULTITHREADED); {Je ne sais pas si c'est utile, mais...}
+finalization;
+  CoUninitialize();
+end.
+</code>
+===== Résultat =====
+{{:prog:lazarus:cas:wmi:extra1.jpg|}}
+====== Sources & Ressources ======
+  * [[https://wiki.lazarus.freepascal.org/LazActiveX]]
+  * [[https://theroadtodelphi.com/2011/04/18/delphi-and-wmi-events/]]