====== 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.

Et effectivement avec **Delphi** çà marche, mais avec **Lazarus**, cela ne fonctionne pas !

Le **PROBLÈME** est ce fichu fichier ''WbemScripting_TLB.pas'' qui vient d'une importation d'un fichier TLB ''C:\WINDOWS\system32\wbem\wbemdisp.TLB'' pour le fichier originale et ''C:\Windows\SysWOW64\wbem\wbemdisp.TLB'' pour le fichier que j'ai moi même régénéré.\\
Ce fichier n'est pas compatible avec **Lazarus**.

J'ai donc décidé de créer ce fichier à partir de **Lazarus** et j'explique ci-dessous comment j'ai fait et les modifications a faire au code source pour que cela fonctionne.

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 [enable_line_numbers="true"]>
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, WbemScripting_TLB, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    FSink:     TSWbemSink;
    FLocator:  ISWbemLocator;
    FServices: ISWbemServices;
    procedure EventReceived(ASender: TObject; const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ 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     := TSWbemSink.Create(self);
  //assign the event handler
  FSink.OnObjectReady := EventReceived;
  //Run the ExecNotificationQueryAsync
  FServices.ExecNotificationQueryAsync(FSink.DefaultInterface,WQL,'WQL', 0, nil, nil);
end;

procedure TForm1.EventReceived(ASender: TObject;
  const objWbemObject: ISWbemObject;
  const 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;

end.
</code>
Source de ce sode : [[https://theroadtodelphi.com/2011/04/18/delphi-and-wmi-events/]]
===== Importer un fichier TLB avec Lazarus =====
==== LazActiveX ====
Dans un premier temps il faut que le paquet ''LazActiveX'' soit installé :

{{: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...'' :

{{:prog:lazarus:cas:wmi:actx2.jpg|}}

Une fois cliqué sur le menu on se retrouve dans cette fenêtre.
  * On choisi [ActiveX References]
  * On cherche [Microsoft WMI Scripting]
  * On clique sur OK et cela nous génére un  fichier ''WbemScripting_1_2_TLB.pas''

{{:prog:lazarus:cas:wmi:actx3.jpg|}}
===== Adaptation du code =====
ATTENTION il y a de grosses differences entre le code généré en **Delphi** et celui en **Lazarus**, hormis le nom du fichier...
==== Exemple avec  TSWbemSink ====


Exemple ''TSWbemSink'' est devenu  ''TEvsSWbemSink'' et ses properties ont changé: 
<code delphi Delphi [enable_line_numbers="true"]>
  TSWbemSink = class(TOleServer)
  private
    FOnObjectReady: TSWbemSinkOnObjectReady;
    FOnCompleted: TSWbemSinkOnCompleted;
    FOnProgress: TSWbemSinkOnProgress;
    FOnObjectPut: TSWbemSinkOnObjectPut;
    FIntf: ISWbemSink;
    ...
    function GetDefaultInterface: ISWbemSink;
  protected
    procedure InitServerData; override;
    procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: ISWbemSink);
    procedure Disconnect; override;
    procedure Cancel;
    property DefaultInterface: ISWbemSink read GetDefaultInterface;
  published
    property OnObjectReady: TSWbemSinkOnObjectReady read FOnObjectReady write FOnObjectReady;
    property OnCompleted: TSWbemSinkOnCompleted read FOnCompleted write FOnCompleted;
    property OnProgress: TSWbemSinkOnProgress read FOnProgress write FOnProgress;
    property OnObjectPut: TSWbemSinkOnObjectPut read FOnObjectPut write FOnObjectPut;
  end;

</code>
<code delphi Lazarus [enable_line_numbers="true"]>
  TEvsSWbemSink = Class(TEventSink)
  Private
    FOnOnObjectReady:TISWbemSinkEventsOnObjectReady;
    FOnOnCompleted:TISWbemSinkEventsOnCompleted;
    FOnOnProgress:TISWbemSinkEventsOnProgress;
    FOnOnObjectPut:TISWbemSinkEventsOnObjectPut;

    fServer:ISWbemSink;
    procedure EventSinkInvoke(Sender: TObject; DispID: Integer;
          const IID: TGUID; LocaleID: Integer; Flags: Word;
          Params: tagDISPPARAMS; VarResult, ExcepInfo, ArgErr: Pointer);
  Public
    constructor Create(TheOwner: TComponent); override;
    property ComServer:ISWbemSink read fServer;
    property OnOnObjectReady : TISWbemSinkEventsOnObjectReady read FOnOnObjectReady write FOnOnObjectReady;
    property OnOnCompleted : TISWbemSinkEventsOnCompleted read FOnOnCompleted write FOnOnCompleted;
    property OnOnProgress : TISWbemSinkEventsOnProgress read FOnOnProgress write FOnOnProgress;
    property OnOnObjectPut : TISWbemSinkEventsOnObjectPut read FOnOnObjectPut write FOnOnObjectPut;

  end;

</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/]]