The Road to Delphi

Delphi – Free Pascal – Oxygene

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

16 Comments

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.

Author: Rodrigo

Just another Delphi guy.

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

  1. “Win32_Volume” not available under Windows XP. May be “Win32_Account” better?

    Some classes return Null for “Caption”, for exclude errors it’s required NullStrictConvert := False;

    For non USA country OEM(console) and ANSI(windows) code pages are differents. So, before Writeln(String) it’s need use something like:

    function ToConsoleCP(const S: string): string;
    var
      Len: Integer;
    begin
      Len := Length(S);
      SetLength(Result, Len);
      if Len > 0 then
        CharToOemBuff(Pointer(S), Pointer(Result), Len);
    end;
    
    • Serge the Win32_Volume class and the caption property was just used as a sample, you are right about which the Win32_Volume class is not present in Windows XP, but you can use any class instead. about the null values in the caption property. Any property can return null values in these cases you can use the NullStrictConvert (as you say) or a helper function which manage the null values properly (in this article i don’t include any code to handle null values, but is you read my old post about the WMI you can found many samples handling null values). finally thanks for your suggestion about use the CharToOemBuff function, but remember the code provided are just simple examples of consoles applications. in real world application generally you uses a VCL application.

  2. Pingback: Accesing the WMI from Pascal Code (Delphi, Oxygene, FreePascal) « The Road to Delphi – a Blog about programming

  3. Hello there, I seem to have a problem. Your code works as expected when the APPTYPE is set CONSOLE, but the CoInitializeEx does not return success when using APPTYPE GUI in Lazarus (FPC). Can you help me, please? :)

    • You don’t need to call the CoInitializeEx function in a GUI Lazarus App, because this function is already executed by the system in the initialization part. check this working sample

      uses
        Windows,
        Variants,
        ActiveX,
        JwaWbemCli;
      
      procedure TForm1.Button1Click(Sender: TObject);
      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;
        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
                 // Get the data from the query
                 while (ppEnum.Next(WBEM_INFINITE, 1, apObjects, puReturned)=0) do
                 begin
                   apObjects.Get('Caption', 0, pVal, pType, plFlavor);
                   ShowMessage(pVal);
                   VarClear(pVal);
                 end;
              end
              else
              ShowMessage(Format('Error executing WQL sentence %x',[Succeed]));
            finally
              FUnsecuredApartment := nil;
            end;
          finally
            FWbemServices := nil;
          end;
        finally
          FWbemLocator := nil;
        end;
      end;      
      
  4. Thank you my friend! Your code works like a charm! I’ll be integrating it into a future open source project and I’ll inform you when it’s released… Thanks again! :)

  5. the example above is awesome. Many thanks. Is it possible to connect to a remote computer?. Your other article on late binding wmi shows you can with that method. I like how above example allows you to retrieve a value by providing the attribute name as a string, but also need to access remote computers. Struggling to figure it out. Can you help

  6. Hello Rodrigo ,

    on My PC with Lazarus 1.0.6 Windows 7 the function CoInitializeSecurity fails error : $80010119 –> RPC_E_TOO_LATE

    RPC_E_TOO_LATE means CoInitializeSecurity has been already called. You will
    have to trace your code and find out where it is been called. If I remmeber
    correctly, In the Run method of the ATL service Template, just after the
    CoInitialize(Ex), CoInitializeSecurity is called. CoInitializeSecurity is
    called only once per process

    I have changed your code with :
    var hres : HRESULT;
    hres := CoInitializeSecurity(nil, -1, nil, nil, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE, nil);
    if (Failed(hres)) AND (hres RPC_E_TOO_LATE) then Exit;

    Friendly , J.P

    • oops an error occurs f (Failed(hres)) AND (hres “” RPC_E_TOO_LATE) then Exit;
      hres not equal to RPC_E_TOO_LATE

    • Hi, I just test the sample codes of this post and works fine in Lazarus 1.0.6, so are you executing the same code or are you using only part of the code in another app?

      • It is the same code at the beginning of the code but the difference is that it is a GUI app not a console App.
        In my project only one button and one memo in a form. When i click on button, i execute wmi code. it is a 32 bits compilation on a 64 bits WIN7 system.
        May be it is the Lazarus Settings or computer settings which product this error.
        The test of RPC_E_TOO_LATE can help people who have the same problem.

  7. I have always this error in a lazarus project with one button and a memo in a form just after a fresh reboot.
    May be because it is a GUI application ?
    May be the settings of Lazarus or because i am using Lazarus 32 bits on a 64 bits O.S ( the application is compiled 32 bits)
    or a computer setting.
    it is not very important and the test with RPC_E_TOO_LATE isn’t dangerous.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s