Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Delphi Get CPU information

Posted on 2014-09-08
5
Medium Priority
?
1,165 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
3 Comments
 
LVL 28

Assisted Solution

by:Sinisa Vuk
Sinisa Vuk earned 1000 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 38

Accepted Solution

by:
Geert Gruwez earned 1000 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: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering 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

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…
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…
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…
Screencast - Getting to Know the Pipeline
Suggested Courses

782 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