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 LibraryAccessing 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.
April 21, 2011 at 9:34 pm
“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:
April 21, 2011 at 10:34 pm
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.
Pingback: Accesing the WMI from Pascal Code (Delphi, Oxygene, FreePascal) « The Road to Delphi – a Blog about programming
January 15, 2012 at 4:07 pm
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? :)
January 15, 2012 at 4:37 pm
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
January 15, 2012 at 4:47 pm
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! :)
February 1, 2012 at 4:22 pm
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
February 1, 2012 at 4:25 pm
I a using free pascal
February 1, 2012 at 5:54 pm
Ivan try using the WMI Delphi Code Creator (https://theroadtodelphi.wordpress.com/wmi-delphi-code-creator/), this tool can create FPC compatible code to access remote machines using the WMI.
February 22, 2013 at 10:45 am
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
February 22, 2013 at 10:50 am
oops an error occurs f (Failed(hres)) AND (hres “” RPC_E_TOO_LATE) then Exit;
hres not equal to RPC_E_TOO_LATE
February 22, 2013 at 11:08 am
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?
February 22, 2013 at 8:15 pm
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.
February 23, 2013 at 12:55 am
The error appears if you run the same code of the article?
February 23, 2013 at 2:59 am
No ! no error with the code of this article.
for that it seems that the error come with a Lazarus GUI app.
February 22, 2013 at 2:17 pm
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.