The Road to Delphi

Delphi – Free Pascal – Oxygene


2 Comments

Added support to TSMBIOS for SMBIOS 2.8 spec.

A few weeks ago (3 Apr 2013) a new update to the System Management BIOS (SMBIOS) Reference Specification was introduced by the DMTF. So the TSMBIOS project was updated to support the SMBIOS 2.8.

The following changes was added to the 2.8 version:

  • Processor Information (Type 4):
  1. SMBIOSCR00106: processor family name correction (48h)
  2. SMBIOSCR00107: new processor family types
  3. SMBIOSCR00108: new processor family type
  4. SMBIOSCR00110: correct typo in table 24 (processor upgrade)
  5. SMBIOSCR00118: new processor family types
  6. SMBIOSCR00121: new processor family type
  7. SMBIOSCR00122: new processor upgrade type
  8. SMBIOSCR00125: add new Intel socket type
  • Memory Device (Type 17):
  1. SMBIOSCR00109: add minimum, maximum and configured voltages
  2. SMBIOSCR00114: add LRDIMM to memory device list
  • Other:
  1. SMBIOSCR00116: correct/clarify structure length fields
  2. SMBIOSCR00120: add new supported processor architectures
  3. SMBIOSCR00123: update referenced specifications
  4. Wording updates for clarity and consistency


11 Comments

Getting Processor Info using Object Pascal (Delphi / FPC) and the TSMBIOS

New_Core_I7 The SMBIOS expose the info about the installed processors in the table type 4. Check the next snippet that shows how obtain such data using the TSMBIOS (remember, if you are using FPC, you can use this library in Windows and Linux).

{$IFDEF FPC}{$mode objfpc}{$H+}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
  Classes,
  TypInfo,
  SysUtils,
  uSMBIOS;

function SetToString(Info: PTypeInfo; const Value): String;
var
  LTypeInfo  : PTypeInfo;
  LIntegerSet: TIntegerSet;
  I: Integer;

begin
  Result := '';

    Integer(LIntegerSet) := 0;
    case GetTypeData(Info)^.OrdType of
      otSByte, otUByte: Integer(LIntegerSet)  := Byte(Value);
      otSWord, otUWord: Integer(LIntegerSet)  := Word(Value);
      otSLong, otULong: Integer(LIntegerSet)  := Integer(Value);
    end;

  LTypeInfo  := GetTypeData(Info)^.CompType{$IFNDEF FPC}^{$ENDIF};
  for I := 0 to SizeOf(Integer) * 8 - 1 do
    if I in LIntegerSet then
    begin
      if Result <> '' then Result := Result + ',';
      Result := Result + GetEnumName(LTypeInfo, I);
    end;
end;


procedure GetProcessorInfo;
Var
  SMBios             : TSMBios;
  LProcessorInfo     : TProcessorInformation;
  LSRAMTypes         : TCacheSRAMTypes;
begin
  SMBios:=TSMBios.Create;
  try
      WriteLn('Processor Information');
      if SMBios.HasProcessorInfo then
      for LProcessorInfo in SMBios.ProcessorInfo do
      begin
        WriteLn('Manufacturer       '+LProcessorInfo.ProcessorManufacturerStr);
        WriteLn('Socket Designation '+LProcessorInfo.SocketDesignationStr);
        WriteLn('Type               '+LProcessorInfo.ProcessorTypeStr);
        WriteLn('Familiy            '+LProcessorInfo.ProcessorFamilyStr);
        WriteLn('Version            '+LProcessorInfo.ProcessorVersionStr);
        WriteLn(Format('Processor ID       %x',[LProcessorInfo.RAWProcessorInformation^.ProcessorID]));
        WriteLn(Format('Voltaje            %n',[LProcessorInfo.GetProcessorVoltaje]));
        WriteLn(Format('External Clock     %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.ExternalClock]));
        WriteLn(Format('Maximum processor speed %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.MaxSpeed]));
        WriteLn(Format('Current processor speed %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.CurrentSpeed]));
        WriteLn('Processor Upgrade   '+LProcessorInfo.ProcessorUpgradeStr);
        WriteLn(Format('External Clock     %d  Mhz',[LProcessorInfo.RAWProcessorInformation^.ExternalClock]));

        if SMBios.SmbiosVersion>='2.3' then
        begin
          WriteLn('Serial Number      '+LProcessorInfo.SerialNumberStr);
          WriteLn('Asset Tag          '+LProcessorInfo.AssetTagStr);
          WriteLn('Part Number        '+LProcessorInfo.PartNumberStr);
          if SMBios.SmbiosVersion>='2.5' then
          begin
            WriteLn(Format('Core Count         %d',[LProcessorInfo.RAWProcessorInformation^.CoreCount]));
            WriteLn(Format('Cores Enabled      %d',[LProcessorInfo.RAWProcessorInformation^.CoreEnabled]));
            WriteLn(Format('Threads Count      %d',[LProcessorInfo.RAWProcessorInformation^.ThreadCount]));
            WriteLn(Format('Processor Characteristics %.4x',[LProcessorInfo.RAWProcessorInformation^.ProcessorCharacteristics]));
          end;
        end;
        Writeln;

        if (LProcessorInfo.RAWProcessorInformation^.L1CacheHandle>0) and (LProcessorInfo.L2Chache<>nil)  then
        begin
          WriteLn('L1 Cache Handle Info');
          WriteLn('--------------------');
          WriteLn('  Socket Designation    '+LProcessorInfo.L1Chache.SocketDesignationStr);
          WriteLn(Format('  Cache Configuration   %.4x',[LProcessorInfo.L1Chache.RAWCacheInformation^.CacheConfiguration]));
          WriteLn(Format('  Maximum Cache Size    %d Kb',[LProcessorInfo.L1Chache.GetMaximumCacheSize]));
          WriteLn(Format('  Installed Cache Size  %d Kb',[LProcessorInfo.L1Chache.GetInstalledCacheSize]));
          LSRAMTypes:=LProcessorInfo.L1Chache.GetSupportedSRAMType;
          WriteLn(Format('  Supported SRAM Type   [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));
          LSRAMTypes:=LProcessorInfo.L1Chache.GetCurrentSRAMType;
          WriteLn(Format('  Current SRAM Type     [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));

          WriteLn(Format('  Error Correction Type %s',[ErrorCorrectionTypeStr[LProcessorInfo.L1Chache.GetErrorCorrectionType]]));
          WriteLn(Format('  System Cache Type     %s',[SystemCacheTypeStr[LProcessorInfo.L1Chache.GetSystemCacheType]]));
          WriteLn(Format('  Associativity         %s',[LProcessorInfo.L1Chache.AssociativityStr]));
        end;

        if (LProcessorInfo.RAWProcessorInformation^.L2CacheHandle>0)  and (LProcessorInfo.L2Chache<>nil)  then
        begin
          WriteLn('L2 Cache Handle Info');
          WriteLn('--------------------');
          WriteLn('  Socket Designation    '+LProcessorInfo.L2Chache.SocketDesignationStr);
          WriteLn(Format('  Cache Configuration   %.4x',[LProcessorInfo.L2Chache.RAWCacheInformation^.CacheConfiguration]));
          WriteLn(Format('  Maximum Cache Size    %d Kb',[LProcessorInfo.L2Chache.GetMaximumCacheSize]));
          WriteLn(Format('  Installed Cache Size  %d Kb',[LProcessorInfo.L2Chache.GetInstalledCacheSize]));
          LSRAMTypes:=LProcessorInfo.L2Chache.GetSupportedSRAMType;
          WriteLn(Format('  Supported SRAM Type   [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));
          LSRAMTypes:=LProcessorInfo.L2Chache.GetCurrentSRAMType;
          WriteLn(Format('  Current SRAM Type     [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));

          WriteLn(Format('  Error Correction Type %s',[ErrorCorrectionTypeStr[LProcessorInfo.L2Chache.GetErrorCorrectionType]]));
          WriteLn(Format('  System Cache Type     %s',[SystemCacheTypeStr[LProcessorInfo.L2Chache.GetSystemCacheType]]));
          WriteLn(Format('  Associativity         %s',[LProcessorInfo.L2Chache.AssociativityStr]));
        end;

        if (LProcessorInfo.RAWProcessorInformation^.L3CacheHandle>0) and (LProcessorInfo.L3Chache<>nil) then
        begin
          WriteLn('L3 Cache Handle Info');
          WriteLn('--------------------');
          WriteLn('  Socket Designation    '+LProcessorInfo.L3Chache.SocketDesignationStr);
          WriteLn(Format('  Cache Configuration   %.4x',[LProcessorInfo.L3Chache.RAWCacheInformation^.CacheConfiguration]));
          WriteLn(Format('  Maximum Cache Size    %d Kb',[LProcessorInfo.L3Chache.GetMaximumCacheSize]));
          WriteLn(Format('  Installed Cache Size  %d Kb',[LProcessorInfo.L3Chache.GetInstalledCacheSize]));
          LSRAMTypes:=LProcessorInfo.L3Chache.GetSupportedSRAMType;
          WriteLn(Format('  Supported SRAM Type   [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));
          LSRAMTypes:=LProcessorInfo.L3Chache.GetCurrentSRAMType;
          WriteLn(Format('  Current SRAM Type     [%s]',[SetToString(TypeInfo(TCacheSRAMTypes), LSRAMTypes)]));

          WriteLn(Format('  Error Correction Type %s',[ErrorCorrectionTypeStr[LProcessorInfo.L3Chache.GetErrorCorrectionType]]));
          WriteLn(Format('  System Cache Type     %s',[SystemCacheTypeStr[LProcessorInfo.L3Chache.GetSystemCacheType]]));
          WriteLn(Format('  Associativity         %s',[LProcessorInfo.L3Chache.AssociativityStr]));
        end;

        Readln;
      end
      else
      Writeln('No Processor Info was found');
  finally
   SMBios.Free;
  end;
end;        

ProcessorInfo2


12 Comments

Introducing TSMBIOS

logoA few weeks ago I started a new project called TSMBIOS, this is a library which allows access the SMBIOS using the Object Pascal language (Delphi or Free Pascal).

What is the SMBIOS?

SMBIOS stands for System Management BIOS , this standard is tightly related and developed by the DMTF (Desktop Management Task Force).

The SMBIOS contains a description of the system’s hardware components, the information stored in the SMBIOS typically includes system manufacturer, model name, serial numbers, BIOS version, asset tag, processors, ports, device memory installed and so on.

Note : The amount and accuracy of the SMBIOS information depends on the computer manufacturer.

Which are the advantages of use the SMBIOS?

  • You can retrieve the information without having to probe for the actual hardware. this is a good point in terms of speed and safeness.
  • The SMBIOS information is very well documented.
  • You can avoid the use of undocumented functions to get hardware info (for example the RAM type and manufacturer).
  • Useful for create a Hardware ID (machine fingerprint).

How it works?

The BIOS typically populates the SMBIOS structures at system boot time, and is not in control when the OS is running. Therefore, dynamically changing data is rarely represented in SMBIOS tables.

The SMBIOS Entry Point is located somewhere between the addresses 0xF0000 and 0xFFFFF, in early Windows systems (Win95, Win98) it was possible access this space address directly, but after with the introduction of the NT Systems and the new security changes the BIOS was accessible through section \Device\PhysicalMemory, but this last method was disabled as well in Windows Server 2003 Service Pack 1, and replaced with 2 new WinApi functions the EnumSystemFirmwareTables and GetSystemFirmwareTable, Additionally  the WMI supports reading the entire contents of SMBIOS data i using the MSSMBios_RawSMBiosTables class inside of the root\wmi namespace.

Note : you can find more information about the SMBIOS Support in Windows on this link.

The TSMBIOS can be compiled using a WinApi mode (uses the GetSystemFirmwareTable function) or using the WMI Mode (uses the MSSMBios_RawSMBiosTables class)

If you uses the WinApi Mode you  don’t need use COM and the final size of the Application will be smaller, but the WinAPI functions was introduced in Windows Vista and Windows XP x64 (So in Windows Xp x86 will fail). Otherwise using the WMI mode you will need use COM (CoInitialize and CoUninitialize), but also you will get two additional advantages 1) The WMI will work even in Windows Xp x86 systems, 2) You can read then SMBIOS data of local and remote computers.

In order to use the TSMBIOS in your application only you must add the uSMBIOS unit to your uses clause, then create a instance for the TSMBios class using the proper constructor

// Default constructor, used for populate the TSMBIOS class  using the current mode selected (WMI or WinApi)
constructor Create; overload;
// Use this constructor to load the SMBIOS data from a previously saved file.
constructor Create(const FileName : string); overload;
{$IFDEF USEWMI}
// Use this constructor to read the SMBIOS from a remote machine.
constructor Create(const RemoteMachine, UserName, Password : string); overload;
{$ENDIF}

and finally use the property which expose the SMBIOS info which you need. In this case as is show in the sample code the BatteryInformation property is used to get all the info of the batteries installed on the system.

{$APPTYPE CONSOLE}

uses
  Classes,
  SysUtils,
  uSMBIOS in '..\..\Common\uSMBIOS.pas';

procedure GetBatteryInfo;
Var
  SMBios : TSMBios;
  LBatteryInfo  : TBatteryInformation;
begin
  SMBios:=TSMBios.Create;
  try
      WriteLn('Battery Information');
      WriteLn('-------------------');
      if SMBios.HasBatteryInfo then
      for LBatteryInfo in SMBios.BatteryInformation do
      begin
        WriteLn('Location           '+LBatteryInfo.GetLocationStr);
        WriteLn('Manufacturer       '+LBatteryInfo.GetManufacturerStr);
        WriteLn('Manufacturer Date  '+LBatteryInfo.GetManufacturerDateStr);
        WriteLn('Serial Number      '+LBatteryInfo.GetSerialNumberStr);
        WriteLn('Device Name        '+LBatteryInfo.GetDeviceNameStr);
        WriteLn('Device Chemistry   '+LBatteryInfo.GetDeviceChemistry);
        WriteLn(Format('Design Capacity    %d mWatt/hours',[LBatteryInfo.RAWBatteryInfo.DesignCapacity*LBatteryInfo.RAWBatteryInfo.DesignCapacityMultiplier]));
        WriteLn(Format('Design Voltage     %d mVolts',[LBatteryInfo.RAWBatteryInfo.DesignVoltage]));
        WriteLn('SBDS Version Number  '+LBatteryInfo.GetSBDSVersionNumberStr);
        WriteLn(Format('Maximum Error in Battery Data %d%%',[LBatteryInfo.RAWBatteryInfo.MaximumErrorInBatteryData]));
        WriteLn(Format('SBDS Version Number           %.4x',[LBatteryInfo.RAWBatteryInfo.SBDSSerialNumber]));
        WriteLn('SBDS Manufacture Date  '+LBatteryInfo.GetSBDSManufactureDateStr);
        WriteLn('SBDS Device Chemistry  '+LBatteryInfo.GetSBDSDeviceChemistryStr);
        WriteLn(Format('OEM Specific                  %.8x',[LBatteryInfo.RAWBatteryInfo.OEM_Specific]));
        WriteLn;
      end
      else
      Writeln('No Battery Info was found');
  finally
   SMBios.Free;
  end;
end;

begin
 try
    GetBatteryInfo;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

TSMBIOS Features

  • Source Full documented compatible with the help insight feature, available since Delphi 2005.
  • Supports SMBIOS Version from 2.1 to 2.7.1
  • Supports Delphi 5, 6, 7, 2005, BDS/Turbo 2006 and RAD Studio 2007, 2009, 2010, XE, XE2, XE3, XE4.
  • Compatible with FPC 2.6.0 (Windows and Linux)
  • SMBIOS Data can be obtained using WinApi, WMI or loading a saved SMBIOS dump
  • SMBIOS Data can be saved and load to a file
  • SMBIOS Data can be obtained from remote machines

SMBIOS Tables supported

The TSMBIOS is a Open Source project is hosted in the Github.


Leave a comment

WMI Delphi Code Creator – New features and source code published in google code

Update : The WMI Delphi Code Creator now is hosted on Github.

In the last months I’ been working in a new version of the WMI Delphi Code Creator, porting the original code from Delphi 2007 to XE, adding new features like support for Delphi Prism and Free Pascal, and improving the source code generated by the tool. Now is time to show the results, so the new version is here with many new features,  also  the full source code is now available in the google code project hosting site under the Mozilla Public License 1.1

 

Check the list of features of the current version

  • Can generate object pascal code compatible with one of these compilers Delphi Win32, Delphi -Prism (Oxygene) , Free Pascal
  • The Delphi code generated is compatible with  Delphi 7, 2005, BDS/Turbo 2006 and RAD Studio 2007, 2009, 2010, XE.
  • The Free Pascal code generated is compatible with these versions 2.4.2, 2.4.4
  • The Delphi prism .Net  (Oxygene) generated code is compatible with all the versions up to 4.0.23.741 (in newer versions must work too)
  • Full access to metadata of any WMI Class registered in the system including qualifiers, mof definition, properties, methods, events
  • You can access directly from the application the MSDN web page related to the WMI Class which your are using.
  • Compile and run the generated code directly form the application using the selected compiler.
  • Open the the generated Delphi code in any of these  Delphi IDE’s 7, 2005, BDS/Turbo 2006 and RAD Studio 2007, 2009, 2010, XE
  • Open the the generated Free Pascal code directly in the Lazarus IDE.
  • Open the the generated Delphi Prism code directly in Visual Studio 2008, Visual Studio 2010 or MonoDevelop.
  • Runs on Windows XP, 2003, 2008, Vista and 7.
  • Themes support for Syntax highlighting (+50 themes included) compatible with the Delphi IDE Theme Editor.

For download the new version of the application and more details go to project page


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.


4 Comments

Compile, Debug and Run your Pascal code online.

Do you want test a short Pascal snippet and you don’t have a compiler? try the site called ideone.

What is ideone?
Ideone is something more than a pastebin; it’s an online compiler and debugging tool which allows
to compile and run code online in more than 40 programming languages.

This site currently supports these two Pascal compilers

fpc (Free Pascal Compiler) 2.2.0 (Target OS: Linux for i386)
gpc (GNU Pascal Compiler) 20070904

for the limitations about the code submitted and others check the FAQ.