CPUInfo via WMI

This example demonstrates how to retrieve processor information by using Windows Management Instrumentation. This example I created as my response to a subject posted in Delphi Indonesia Forum titled ngebaca s/n processor dgn delphi. For a complete source code, you can donwload it from Delphi Indonesia Forum (onDownload section).

{
  CPUInfo, An attempt on CPU information retrieval using
           Windows Management Instrumentation (WMI)
  Copyright (c) 2005 Bayu Prasetio

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

  The current web address of the GNU General Public License is:
  http://www.gnu.org/licenses/gpl.html

  You can contact the authors of this software at:
  bpras@bprasetio.or.id

  ------------------------------------------------------------------------------

  Portions of the code are belong to Comprehensive Open Source Benchmarking
  Initiative (COSBI) authors and its contributors, copyright COSBI Team.
  For further information about COSBI please refers to
  http://www.flickerdown.com/osmark/ or http://www.cosbi.org
}
unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ValEdit, WbemScripting_TLB, ActiveX, ComCtrls, XPMan;

type
  TfrmMain = class(TForm)
    vleCPUInfo: TValueListEditor;
    stbMain: TStatusBar;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FLocator : TSWBEMLocator;
    FSinkClasses : TSWbemSink;
    procedure RetrieveCPUInfo;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{ TfrmMain }

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FLocator := TSWBEMLocator.Create(nil);
  FSinkClasses := TSWBEMSink.Create(nil);

  RetrieveCPUInfo;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FSinkClasses.Free;
  FLocator.Free;
end;

procedure TfrmMain.RetrieveCPUInfo;
var
  lServices   : ISWbemServices;
  lObjectSet  : ISWbemObjectSet;
  lSObject    : ISWbemObject;
  lPropSet    : ISWbemPropertySet;
  lSProp      : ISWbemProperty;
  propEnum    : IEnumVariant;
  Enum        : IEnumVariant;
  tempObj     : OleVariant;
  Count       : Cardinal;
  Value       : Cardinal;
  sValue      : String;

begin
  Screen.Cursor := crHourGlass;
  try
    FSinkClasses.Cancel;

    // connect to local and use root\CIMV2 namespace
    lServices := FLocator.ConnectServer('', 'root\CIMV2', '', '', '', '', 0, nil);

    // retrieve the Win32_Processor information
    lObjectSet := lServices.ExecQuery('SELECT * FROM Win32_Processor', 'WQL',
                                      wbemFlagReturnImmediately, nil);
    Enum :=  ( lObjectSet._NewEnum ) as IEnumVariant;
    while (Enum.Next(1, tempObj, Value) = S_OK) do
    begin
      lSObject := IUnknown(tempObj) as SWBemObject;
      lpropSet := lSObject.Properties_;
      propEnum := (lpropSet._NewEnum) as IEnumVariant;
      while (propEnum.Next(1, tempObj, Value) = S_OK) do
      begin
        lSProp := IUnknown(tempObj) as SWBemProperty;
        if VarIsNull(lSProp.Get_Value) then
          sValue := '<empty>'
        else
        case lSProp.CIMType of
          wbemCimtypeSint8,
          wbemCimtypeUint8,
          wbemCimtypeSint16,
          wbemCimtypeUint16,
          wbemCimtypeSint32,
          wbemCimtypeUint32,
          wbemCimtypeSint64:
            if VarIsArray(lSProp.Get_Value) then
            begin
              if VarArrayHighBound(lSProp.Get_Value, 1) > 0 then
                for Count := 1 to VarArrayHighBound(lSProp.Get_Value, 1) do
                  sValue := sValue + ' ' + IntToStr(lSProp.Get_Value[Count]);
            end
            else
              sValue := IntToStr(lSProp.Get_Value);

          wbemCimtypeReal32,
          wbemCimtypeReal64: sValue := FloatToStr(lSProp.Get_Value);

          wbemCimtypeBoolean:
            if lSProp.Get_Value then
              sValue := 'True'
            else
              sValue := 'False';

          wbemCimtypeString, wbemCimtypeUint64:
            if VarIsArray(lSProp.Get_Value) then
            begin
              if VarArrayHighBound(lSProp.Get_Value, 1) > 0 then
                for Count := 1 to VarArrayHighBound(lSProp.Get_Value, 1) do
                  sValue := sValue + ' ' + lSProp.Get_Value[Count];
            end
            else
              sValue :=  lSProp.Get_Value;

          wbemCimtypeDatetime: sValue :=  lSProp.Get_Value;
          wbemCimtypeReference: sValue := lSProp.Get_Value;
          wbemCimtypeChar16: sValue := '&lt;16-bit character>';
          wbemCimtypeObject: sValue := '<cim Object>';
        else
          sValue := 'Unknown type';
        end; {case}

        // fill the property name & its value to ValueListEditor
        vleCPUInfo.Strings.Add(lsProp.Name + '=' + sValue);
      end; {while propEnum}
    end; {while Enum}
  finally
    FLocator.Disconnect;
    Screen.Cursor := crDefault;
  end; {try}
end;

end.

Advertisement