How get information about Processor in Delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WbemScripting_TLB, activex, IpHlpApi;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  aString  = array of string;
  a2String = array [0..1] of aString;
 
type
  pDevices = ^tDevices;
  tDevices = record
    Next : pDevices;
    Vals : a2String;
  end;
 
  procedure CreateList;
  procedure AddToList(Tablica : a2String);
  procedure DestroyList;
  procedure PrintAll(Memo : TMemo);
  function  getPropValue(sprop:ISWbemProperty):string;
  procedure getAdapters(owner:TComponent; wmiClass : string; Model : aString);
 
var
  Form1              : TForm1;
  Root, Last         : pDevices;
  LAN_root, LAN_last : pLAN_Devices;
 
implementation
 
{$R *.dfm}
 
uses
  IpTypes;
 
  procedure CreateList;
  begin
    Root := nil;
    Last := nil;
  end;
 
  procedure AddToList(Tablica : a2String);
    var
      NewOne      : pDevices;
      tmp_tablica : a2String;
      i, n        : integer;
  begin
    New(NewOne);
    NewOne^.Next := nil;
    n := Length(Tablica[0]);
    SetLength(tmp_tablica[0], n);
    SetLength(tmp_tablica[1], n);
    for i := 0 to n - 1 do begin
      tmp_tablica[0][i] := Tablica[0][i];
      tmp_tablica[1][i] := Tablica[1][i];
    end;
    NewOne^.Vals := tmp_tablica;
    if Root = nil then begin
      Root := NewOne;
      Last := Root;
    end else begin
      Last^.Next := NewOne;
      Last := NewOne;
    end;
  end;
 
  procedure DestroyList;
    var
      ToDelete  : pDevices;
  begin
    while Root <> nil do begin
      ToDelete := Root;
      Root     := Root^.Next;
      Dispose(ToDelete);
    end;
  end;
 
  procedure PrintAll(Memo : TMemo);
    var
      Lista    : pDevices;
      Lista_   : a2String;
      i, n     : integer;
  begin
    Lista := Root;
    while Lista <> nil do begin
      Lista_ := Lista^.Vals;
      n := Length(Lista_[0]);
      for i := 0 to n - 1 do Memo.Lines.Add(' ------ ' + Lista_[0][i] + ': ' + Lista_[1][i]);
      Lista := Lista^.Next;
      Memo.Lines.Add('');
    end;
    DestroyList;
  end;
 
  function getPropValue(sprop:ISWbemProperty):string;
    var
      sValue : string;
      count  : integer;
  begin
    sValue := '';
    if VarIsNull(SProp.Get_Value) then sValue := 'null'
    else
      case SProp.CIMType of
        wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeSint16, wbemCimtypeUint16,
        wbemCimtypeSint32, wbemCimtypeUint32, wbemCimtypeSint64:
          sValue := IntToStr(SProp.Get_Value);
        wbemCimtypeString, wbemCimtypeUint64:
          if VarIsArray(SProp.Get_Value) then begin
            if VarArrayHighBound(SProp.Get_Value, 1) > 0 then
              for Count := 1 to VarArrayHighBound(SProp.Get_Value, 1) do
                sValue := sValue + ' ' + SProp.Get_Value[Count];
          end else sValue :=  SProp.Get_Value;
        wbemCimtypeDatetime:
          sValue:=SProp.Get_Value;
        else
          Exception.Create('Unknown type');
      end; {case}
    result:=sValue;
  end;
 
  procedure getAdapters(owner:TComponent; wmiClass : string; Model : aString);
    var
      Locator            : TSWbemLocator;
      SinkClasses        : TSWbemSink;
      Services           : ISWbemServices;
      ObjectSet          : ISWbemObjectSet;
      SObject            : ISWbemObject;
      propSet            : ISWbemPropertySet;
      SProp              : ISWbemProperty;
      Enum               : IEnumVariant;
      tempObj            : OleVariant;
      Value              : Cardinal;
      sValue             : String;
      i, j, w1           : integer;
      data               : a2String;
      test               : boolean;
  begin
    w1 := Length(Model);
    SetLength(data[0], w1);
    SetLength(data[1], w1);
    Locator     := TSWbemLocator.Create(owner);
    SinkClasses := TSWbemSink.Create(owner);
    try
      SinkClasses.Cancel;
      Services  := Locator.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil);
      ObjectSet := Services.InstancesOf(wmiClass, wbemFlagReturnImmediately or wbemQueryFlagShallow, nil);
      Enum      := (ObjectSet._NewEnum) as IEnumVariant;
      SetLength(Model, w1);
      CreateList;
      while (Enum.Next(1, tempObj, Value) = S_OK) do begin
        SObject := IUnknown(tempObj) as SWBemObject;
        propSet := SObject.Properties_;
        test    := false;
        for j := 0 to w1 - 1 do begin
          data[0][j] := Model[j];
          data[1][j] := '';
          SProp   := propSet.Item(Model[j], 0);// caption or systemname
          sValue  := getPropValue(SProp);
          if sValue<>'null' then begin
            data[1][j] := sValue;
            test := true;
          end;
        end;
        if test then AddToList(data);
      end; {while Enum}
    finally
    end; {try}
    Locator.Free;
    SinkClasses.Free;
    Services:=nil;
    ObjectSet:=nil;
    SObject:=nil;
    enum:=nil;
  end;
 
  procedure TForm1.Button1Click(Sender: TObject);
    var
      Model    : aString;
  begin
    Memo1.Clear;
 
    Memo1.Lines.Add(''); Memo1.Lines.Add('Procesor');
    SetLength(Model, 4);
    Model[0] := 'Name'; Model[1] := 'Description'; Model[2] := 'CurrentClockSpeed'; Model[3] := 'ProcessorId';
    getAdapters(self, 'Win32_Processor', Model);
    PrintAll(Memo1);
    SetLength(Model, 1);
    Model[0] := 'NumberOfProcessors';
    getAdapters(self, 'Win32_ComputerSystem', Model);
    PrintAll(Memo1);
    Memo1.SetFocus;
  end;
 
end.