Solved

Delphi Get CPU information

Posted on 2014-09-08
5
551 Views
Last Modified: 2015-03-05
Hello,
I need my delphi application to get some CPU information:
CPU Name
Number of cores
Percentage of use per core

Is there any way to get it ?
0
Comment
Question by:Slinkkkk
5 Comments
 
LVL 25

Assisted Solution

by:Sinisa Vuk
Sinisa Vuk earned 250 total points
ID: 40310981
Depends on Delphi version you use....but quick info - example and blogs:
http://delphi.cjcsoft.net/viewthread.php?tid=46937
... using smbios - great example: theroadtodelphi blog
...or WMI: theroadtodelphi blog II
... using great components: MiTeC System Information Component Suite
... and more on Torry
0
 
LVL 19

Expert Comment

by:MerijnB
ID: 40311466
A little addition to Sinisa,

I've been using MiTeC for years for this (which in turn uses smbios), but quite recently stopped using it because of continues different kind of problems. I'd advice to go the WMI route, Sinisa's link on WMI looks quite nice :)
0
 
LVL 36

Accepted Solution

by:
Geert Gruwez earned 250 total points
ID: 40316769
WMI ... i use this to list several specs from servers:
function UIToStr(value: OleVariant): string;
begin
  if VarIsNull(Value) or VarIsEmpty(Value) then
    Result := '0'
  else
    Result := UIntToStr(Value);
end;

function PercentageStr(Size, FreeSpace: OleVariant): string;
var S, F: UInt64;
  P: Extended;
begin
  P := 0;
  S := 0;
  F := 0;
  if not (VarIsNull(Size) or VarIsEmpty(Size)) then
    S := Size;
  if not (VarIsNull(FreeSpace) or VarIsEmpty(FreeSpace)) then
    F := FreeSpace;
  if S <> 0 then
    P := F/S*100;
  Result := Format('%.2f', [P]) + '%';
end;

function BytesToTextString(Size: OleVariant; Precision: integer = 2; Factor: Integer = 1024; Suffix: string = 'Kb'): string;
var S: UInt64;
  P: Extended;
begin
  S := 0;
  if not (VarIsNull(Size) or VarIsEmpty(Size)) then
    S := Size;
  P := S / Factor;
  Result := Format('%.*f', [Precision, P]) + Suffix;
end;

function GBStr(Size: OleVariant; Precision: integer = 2): string;
begin
  Result := BytesToTextString(Size, Precision, 1024*1024*1024, 'Gb');
end;

function MBStr(Size: OleVariant; Precision: integer = 2): string;
begin
  Result := BytesToTextString(Size, Precision, 1024*1024, 'Mb');
end;

procedure TDiscoverServerJobThread.JobDiscoverListDrives(Server, UserName, Password: string; List: TStrings);
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator: OLEVariant;
  FWmiService: OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject: OLEVariant;
  oEnum: IEnumVariant;
  iValue: LongWord;
begin
  List.Clear;

  // connect to the remote computer
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWmiService := FSWbemLocator.ConnectServer(Server, 'root\CIMV2', UserName, Password);
  List.Add('SERVER DISCOVERY START: ' + Server);

{$REGION 'MOTHERBOARD'}
  // list the properties of motherboard
  List.Add('ITEM: MOTHER BOARD');
  try
    fWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM Win32_BaseBoard', 'WQL', wbemFlagForwardOnly);
    oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;

    List.Add('Name;Caption;Description;Manufacturer;Model;Product;Status;Version');
    while (oEnum.Next(1, FWbemObject, iValue) = 0) and not Terminated do
    begin
      List.Add(Format('%s;%s;%s;%s;%s;%s;%s;%s',[
        FWbemObject.Name,
        FWbemObject.Caption,
        FWbemObject.Description,
        FWbemObject.Manufacturer,
        FWbemObject.Model,
        FWbemObject.Product,
        FWbemObject.Status,
        FWbemObject.Version
        ]));
      FWbemObject := Unassigned;
    end;
  except
    on E: Exception do
      List.Add('Error listing properties of mother board: ' + E.Message);
  end;
  List.Add('ITEM END: MOTHER BOARD');
{$ENDREGION}

{$REGION 'COMPUTER SYSTEM'}
  // list the properties of motherboard
  List.Add('ITEM: COMPUTER SYSTEM');
  try
    fWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM Win32_ComputerSystem', 'WQL', wbemFlagForwardOnly);
    oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;

    List.Add('Name;Caption;Description;Manufacturer;Model;NumberOfLogicalProcessors;NumberOfProcessors;TotalPhysicalMemory;Status');
    while (oEnum.Next(1, FWbemObject, iValue) = 0) and not Terminated do
    begin
      List.Add(Format('%s;%s;%s;%s;%s;%s;%s;%s;%s',[
        FWbemObject.Name,
        FWbemObject.Caption,
        FWbemObject.Description,
        FWbemObject.Manufacturer,
        FWbemObject.Model,
        UIToStr(FWbemObject.NumberOfLogicalProcessors),
        UIToStr(FWbemObject.NumberOfProcessors),
        GBStr(FWbemObject.TotalPhysicalMemory, 0),
        FWbemObject.Status
        ]));
      FWbemObject := Unassigned;
    end;
  except
    on E: Exception do
      List.Add('Error listing properties of computer system: ' + E.Message);
  end;
  List.Add('ITEM END: COMPUTER SYSTEM');
{$ENDREGION}

{$REGION 'PROCESSORS'}
  // list the properties of motherboard
  List.Add('ITEM: PROCESSORS');
  try
    fWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM Win32_Processor', 'WQL', wbemFlagForwardOnly);
    oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;

    List.Add('Name;Caption;Description;Manufacturer;ProcessorId;NumberOfCores;NumberOfLogicalProcessors;Status');
    while (oEnum.Next(1, FWbemObject, iValue) = 0) and not Terminated do
    begin
      List.Add(Format('%s;%s;%s;%s;%s;%s;%s;%s',[
        FWbemObject.Name,
        FWbemObject.Caption,
        FWbemObject.Description,
        FWbemObject.Manufacturer,
        FWbemObject.ProcessorId,
        UIToStr(FWbemObject.NumberOfCores),
        UIToStr(FWbemObject.NumberOfLogicalProcessors),
        FWbemObject.Status
        ]));
      FWbemObject := Unassigned;
    end;
  except
    on E: Exception do
      List.Add('Error listing properties of processors: ' + E.Message);
  end;
  List.Add('ITEM END: PROCESSORS');
{$ENDREGION}

{$REGION 'OPERATINGSYSTEM'}
  // list the properties of motherboard
  List.Add('ITEM: OPERATINGSYSTEM');
  try
    fWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM Win32_OperatingSystem', 'WQL', wbemFlagForwardOnly);
    oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;

    List.Add('Name;Caption;Description;Manufacturer;Status;Version');
    while (oEnum.Next(1, FWbemObject, iValue) = 0) and not Terminated do
    begin
      List.Add(Format('%s;%s;%s;%s;%s;%s',[
        FWbemObject.Name,
        FWbemObject.Caption,
        FWbemObject.Description,
        FWbemObject.Manufacturer,
        FWbemObject.Status,
        FWbemObject.Version
        ]));
      FWbemObject := Unassigned;
    end;
  except
    on E: Exception do
      List.Add('Error listing properties of mother board: ' + E.Message);
  end;
  List.Add('ITEM END: OPERATINGSYSTEM');
{$ENDREGION}

{$REGION 'PHYSICAL DRIVES'}
  // list the physical drives
  List.Add('ITEM: PHYSICAL DRIVES');
  try
    fWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM CIM_DiskDrive', 'WQL', wbemFlagForwardOnly);
    oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;

    List.Add(Format('%s;%s;%s;%s;%s',['Name', 'Caption', 'Description', 'DeviceId', 'Status']));
    while (oEnum.Next(1, FWbemObject, iValue) = 0) and not Terminated do
    begin
      List.Add(Format('%s;%s;%s;%s;%s',[
        FWbemObject.Name,
        FWbemObject.Caption,
        FWbemObject.Description,
        FWbemObject.DeviceId,
        FWbemObject.Status
        ]));
      FWbemObject := Unassigned;
    end;
  except
    on E: Exception do
      List.Add('Error listing physical drives: ' + E.Message);
  end;
  List.Add('ITEM END: PHYSICAL DRIVES');
{$ENDREGION}

{$REGION 'LOGICAL DISKS'}
  // list the logical disks
  List.Add('ITEM: LOGICAL DISKS');
  try
    fWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM CIM_LogicalDisk', 'WQL', wbemFlagForwardOnly);
    oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;

    List.Add('Name;Caption;Description;DeviceId;Size;SizeGb;FreeSpace;FreeSpaceGb,Percentage,PercentageStr');
    while (oEnum.Next(1, FWbemObject, iValue) = 0) and not Terminated do
    begin
      List.Add(Format('%s;%s;%s;%s;%s;%s;%s;%s;%s',[
        FWbemObject.Name,
        FWbemObject.Caption,
        FWbemObject.Description,
        FWbemObject.DeviceId,
        UIToStr(FWbemObject.Size),
        GbStr(FWbemObject.Size),
        UIToStr(FWbemObject.FreeSpace),
        GbStr(FWbemObject.FreeSpace),
        PercentageStr(FWbemObject.Size, FWbemObject.FreeSpace)
        ]));
      FWbemObject := Unassigned;
    end;
  except
    on E: Exception do
      List.Add('Error listing logical disks: ' + E.Message);
  end;
  List.Add('ITEM END: LOGICAL DISKS');
{$ENDREGION}

Open in new window

0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now