====== Manipulations avec WMI ======
===== Enumérer les properties d'un SWbemObject=====
// 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;
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;
===== Faire une Requête Asynchrone =====
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 :
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.
==== Exemple généré avec Wmi Delphi Code Creator ====
//-----------------------------------------------------------------------------------------------------
// 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.
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/]]