Solved

Delphi Get CPU information

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

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Run video youtube webbrowse 10 61
Performance of SQL statement 37 111
How to load 2 images in same column in Delphi 2 46
Tvertscrollbox like a whatsapp layout delete messages 1 16
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
This Micro Tutorial hows how you can integrate  Mac OSX to a Windows Active Directory Domain. Apple has made it easy to allow users to bind their macs to a windows domain with relative ease. The following video show how to bind OSX Mavericks to …
Windows 10 is mostly good. However the one thing that annoys me is how many clicks you have to do to dial a VPN connection. You have to go to settings from the start menu, (2 clicks), Network and Internet (1 click), Click VPN (another click) then fi…

776 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