Solved

Delphi Get CPU information

Posted on 2014-09-08
5
716 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 26

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 37

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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

830 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