The Road to Delphi

Delphi – Free Pascal – Oxygene


16 Comments

Accesing the WMI from Delphi and Free Pascal via COM (without late binding or WbemScripting_TLB)

A fellow Delphi programmer,  ask me how they can access the WMI using the  COM API for WMI ,  so I decide write this article to show how.

First you must to know which this API was designed primarily for low level access to the WMI from C++ and for create WMI providers, compile mof files and so on.

In the past articles always I show samples to use the WMI using late binding or importing the Microsoft WMIScripting Library. in both cases you are using the same layer to access the WMI (WMIScripting).

In the next diagram you can see the layers to access the WMI, you can note how the WMIScripting finally access the WMI using the WMI COM API. In the next sample you will learn how avoid this additional layer.

The interfaces of the COM API for WMI are very similar to the Microsoft WMIScripting Library because the last is just a wrapper for the COM object.

Note : the code showed in this article was tested in Delphi 2007, Delphi XE and FPC 2.4.2 and uses the WBEM Client interface Unit for Object Pascal which is an translation of the headers of the WbemCli.h file. this unit called JwaWbemCli is part of the JEDI API Library

Accessing the WMI using the COM Interface


Initialize COM

Microsoft recommends use the CoInitializeEx function with the COINIT_MULTITHREADED flag
the code will looks like so

  if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
  try
    //Execute your WMI code here
  finally
    CoUninitialize();
  end;

Set the general COM security level

Now In order to set the general COM security level you must perform a call to the CoInitializeSecurity function.

CoInitializeSecurity(nil, -1, nil, nil, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE, nil);

Create a connection to a WMI namespace.

FWbemLocator.ConnectServer(strNetworkResource, strUser, strPassword, strLocale,  WBEM_FLAG_CONNECT_USE_MAX_WAIT, strAuthority, nil, FWbemServices)

Set the security levels on the WMI connection.

By definition, WMI runs in a different process than your application. Therefore, you must create a connection between your application and WMI and you must set the impersonation and authentication levels for your application. this must be done using the CoSetProxyBlanket and CoCreateInstance functions.

 CoSetProxyBlanket(FWbemServices, RPC_C_AUTHN_WINNT, RPC_C_AUTHZ_NONE, nil, RPC_C_AUTHN_LEVEL_CALL, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE);
 CoCreateInstance(CLSID_UnsecuredApartment, nil, CLSCTX_LOCAL_SERVER, IID_IUnsecuredApartment, FUnsecuredApartment);

Implement your application (make the WMI query)

        Succeed := FWbemServices.ExecQuery('WQL', WQL, WBEM_FLAG_FORWARD_ONLY, nil, ppEnum);
        if Succeeded(Succeed) then
        begin
           // Get the data from the query
           while (ppEnum.Next(WBEM_INFINITE, 1, apObjects, puReturned)=0) do
           begin
             apObjects.Get('Caption', 0, pVal, pType, plFlavor);
             Writeln(pVal);
             VarClear(pVal);
           end;
        end
        else
        Writeln(Format('Error executing WQL sentence %x',[Succeed]));

Finally Cleanup and shut down your application.

After you complete your queries to WMI, you should destroy all COM pointers to shut down your application correctly. this is made setting the interface to nil to calling the varclear function.

Now a basic sample to make WMI query using the COM interface.


{$IFDEF FPC}
 {$MODE DELPHI} {$H+}
{$ENDIF}

{$APPTYPE CONSOLE}

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;

procedure Test_IWbemServices_ExecQuery;
const
  strLocale    = '';
  strUser      = '';
  strPassword  = '';
  strNetworkResource = 'root\cimv2';
  strAuthority       = '';
  WQL                = 'SELECT * FROM Win32_Volume';
var
  FWbemLocator         : IWbemLocator;
  FWbemServices        : IWbemServices;
  FUnsecuredApartment  : IUnsecuredApartment;
  ppEnum               : IEnumWbemClassObject;
  apObjects            : IWbemClassObject;
  puReturned           : ULONG;
  pVal                 : OleVariant;
  pType                : Integer;
  plFlavor             : Integer;
  Succeed              : HRESULT;
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
        // Use the IWbemServices pointer to make requests of WMI
        //Succeed := FWbemServices.ExecQuery('WQL', WQL, WBEM_FLAG_FORWARD_ONLY OR WBEM_FLAG_RETURN_IMMEDIATELY, nil, ppEnum);
        Succeed := FWbemServices.ExecQuery('WQL', WQL, WBEM_FLAG_FORWARD_ONLY, nil, ppEnum);
        if Succeeded(Succeed) then
        begin
          Writeln('Running Wmi Query..Press Enter to exit');
           // Get the data from the query
           while (ppEnum.Next(WBEM_INFINITE, 1, apObjects, puReturned)=0) do
           begin
             apObjects.Get('Caption', 0, pVal, pType, plFlavor);
             Writeln(pVal);
             VarClear(pVal);
           end;
        end
        else
        Writeln(Format('Error executing WQL sentence %x',[Succeed]));
      finally
        FUnsecuredApartment := nil;
      end;
    finally
      FWbemServices := nil;
    end;
  finally
    FWbemLocator := nil;
  end;
end;

begin
  // Initialize COM. ------------------------------------------
  if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
  try
    Test_IWbemServices_ExecQuery;
  finally
    CoUninitialize();
  end;
  Readln;
end.

And what about the Wmi events?

Ok here i leave the code to manage an async event using the COM WMI API.

Implement the Sink  definition to receive the event

Create a new class which descends from the TInterfacedObject class and the IWbemObjectSink interface, you must implement the Indicate and SetStatus functions.

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;

Initilizate the Sink

Create a instance to the class TWmiEventSink which will handle the received events and use the IUnsecuredApartment.CreateObjectStub function to create a object forwarder sink.

FWmiEventSink := TWmiEventSink.Create;
FUnsecuredApartment.CreateObjectStub(FWmiEventSink, ppStub);

Execute the event

Call the ExecNotificationQueryAsync function passing the sink instance to begin listening the events.

FWbemServices.ExecNotificationQueryAsync('WQL', WQL, WBEM_FLAG_SEND_STATUS, nil, StubSink)

CleanUp

Finally use the CancelAsyncCall function to stop the Event receiver.

FWbemServices.CancelAsyncCall(StubSink);

And this is the full source code to receive the WMI async event


{$IFDEF FPC}
 {$MODE DELPHI} {$H+}
{$ENDIF}

{$APPTYPE CONSOLE}

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;
  wszName       : LPCWSTR;
  pVal          : OleVariant;
  pType         : Integer;
  plFlavor      : Integer;
  lFlags        : Longint;
  Caption, Pid  : string;
begin
  wszName:='TargetInstance';
  lFlags :=0;
  Result := WBEM_S_NO_ERROR;
  if lObjectCount > 0 then
    if Succeeded(apObjArray.Get(wszName, lFlags, pVal, pType, plFlavor)) then
    begin
      Instance := IUnknown(pVal) as IWbemClassObject;
      try
        Instance.Get('Caption', 0, pVal, pType, plFlavor);
        Caption:=pVal;
        VarClear(pVal);

        Instance.Get('ProcessId', 0, pVal, pType, plFlavor);
        Pid:=pVal;
        VarClear(pVal);

        Writeln(Format('Process %s started Pid  %s',[Caption,Pid]));

      finally
        Instance := nil;
      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 __InstanceCreationEvent WITHIN 1 WHERE TargetInstance ISA "Win32_Process"';
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
  // Initialize COM
  if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
  try
    Test_IWbemServices_ExecNotificationQueryAsync;
  finally
    CoUninitialize();
  end;
  Readln;
end.

Check the source code of this article on Github.