delphi uCPUUsage 单元

CPU and RAM usage information *.pas for Delphi x32/x64

unit uCPUInfo;

lightweight unit for access to CPU and RAM usage information

R. Cherepanov, 06.2019

X64 support

interface

uses

SysUtils,

Winapi.PsAPI,

Winapi.Windows;

type

TRegisters=record

case Integer of

0:(EAX,EBX,ECX,EDX:LongWord);

1:(Str1,Str2,Str3,Str4:array[0..3] of AnsiChar );

2:(Str:array[0..15] of AnsiChar );

end;

T_CPU_Info= record

logical_cores: integer;

physical_cores: integer;

L1CacheSize: Int64;

L2CacheSize: Int64;

L3CacheSize: Int64;

RAMSize : Int64;

end;

procedure GetCPUID(Param:Cardinal; var Registers:TRegisters); register;

function IsCPUID_Available:Boolean; register;

function GetExtendeCPUInfo: AnsiString;

function GetCPUInfo: T_CPU_Info;

function GetCPUName: AnsiString;

function GetCPUUsage: real;

function GetProcessMem: Integer;

implementation

function NtQuerySystemInformation (

SystemInformationClass : DWORD; // information type flag

SystemInformation : Pointer; // buffer

SystemInformationLength : DWORD; // fuffer size

var ReturnLength : DWORD // count of bytes to be returned or needed

) : DWORD; stdcall; external 'ntdll.dll';

var

nOldIdleTime : int64 = 0;

nOldSystemTime : int64 = 0;

nNewCPUTime : double = 0;

pmc: PPROCESS_MEMORY_COUNTERS;

function IsCPUID_Available:Boolean; register;

{$IFDEF CPUX64}

asm // x64 version

// FLAGS register in x64 has 64bits, i.e. QWORD,

// PUSHFQ/POPFQ instead of PUSHFD/POPFD for DWORD in x32.

.noframe

PUSHFQ

POP RAX

MOV RBX, RAX

XOR EAX, $200000;

PUSH RAX

POPFQ

PUSHFQ

POP RAX

XOR EAX, EDX

SETNZ AL

end;

{$ELSE}

asm // x32 version

PUSHFD

POP EAX

MOV EDX, EAX

XOR EAX, $200000;

PUSH EAX

POPFD

PUSHFD

POP EAX

XOR EAX, EDX

SETNZ AL

end;

{$ENDIF}

procedure GetCPUID(Param:Cardinal; var Registers:TRegisters); register;

{$IFDEF CPUX64}

asm // X64 version

.noframe

PUSH RBX

PUSH RDI

MOV RDI, Registers

MOV EAX, Param

XOR EBX, EBX

XOR ECX, ECX

XOR EDX, EDX

CPUID

MOV TRegisters(EDI).&EAX, EAX

MOV TRegisters(EDI).&EBX, EBX

MOV TRegisters(EDI).&ECX, ECX

MOV TRegisters(EDI).&EDX, EDX

POP RDI

POP RBX

end;

{$ELSE}

asm // x32 version

PUSH EBX

PUSH EDI

MOV EDI, Registers

XOR EBX, EBX

XOR ECX, ECX

XOR EDX, EDX

CPUID

MOV TRegisters(EDI).&EAX, EAX

MOV TRegisters(EDI).&EBX, EBX

MOV TRegisters(EDI).&ECX, ECX

MOV TRegisters(EDI).&EDX, EDX

POP EDI

POP EBX

end;

{$ENDIF}

function GetCPUInfo: T_CPU_Info;

var

sysinfo : _SYSTEM_INFO;

Buffer : PSYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX;

current_info : PSYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX;

ByteCount : WinApi.Windows.DWORD;

RelationshipType: LOGICAL_PROCESSOR_RELATIONSHIP;

offset : integer;

res: boolean;

statex: MEMORYSTATUSEX;

begin

statex.dwLength := sizeof(statex);

GlobalMemoryStatusEx(statex);

Result.RAMSize := statex.ullTotalPhys;

Result.logical_cores := 0;

Result.physical_cores := 0;

Result.L1CacheSize := 0;

Result.L2CacheSize := 0;

Result.L3CacheSize := 0;

// RelationshipType := RelationProcessorCore;

// RelationshipType := RelationNumaNode;

// RelationshipType := RelationCache;

// RelationshipType := RelationProcessorPackage;

// RelationshipType := RelationGroup;

RelationshipType := RelationAll;

res := GetLogicalProcessorInformationEx(

RelationshipType,

nil,

@ByteCount

);

GetMem(Buffer, ByteCount);

res := GetLogicalProcessorInformationEx(

RelationshipType,

@(Buffer^),

@ByteCount

);

offset := 0;

while (offset < ByteCount) do

begin

current_info := PSYSTEM_LOGICAL_PROCESSOR_INFORMATION_EX( UInt64(buffer) + offset);

offset := offset + current_info^.size;

if Current_info.Relationship = RelationProcessorCore

then

inc(Result.physical_cores);

if current_info.Relationship = RelationCache then

begin

case current_info.Cache.Level of

1: Result.L1CacheSize := Result.L1CacheSize + current_info.Cache.CacheSize;

2: Result.L2CacheSize := Result.L2CacheSize + current_info.Cache.CacheSize;

3: Result.L3CacheSize := Result.L3CacheSize + current_info.Cache.CacheSize;

end; // of CASE

end;

GetSystemInfo(sysinfo);

Result.logical_cores := sysinfo.dwNumberOfProcessors;

end;

function GetCPUName: AnsiString;

var

Registers:TRegisters;

_EAX: LongWord;

FamilyID, ExtFamilyID, ModelID, ExtModelID, ProcType, Stepping: LongWord;

begin

Result:='';

if not IsCPUID_Available then begin

Result := 'CPUID not supported';

Exit;

end;

// get general CPU info

GetCPUID( $00000000,Registers );

// Its fantastic! general info stored at mixed order: EBX:EDX:ECX

Result := Result + Registers.Str2+Registers.Str4+Registers.Str3 + ': ';

// Get extended info string

for _EAX := $80000002 to $80000004 do

begin

GetCPUID( _EAX ,Registers);

Result := Result + Registers.Str;

end;

function GetExtendeCPUInfo: AnsiString;

var

Registers:TRegisters;

MaxEAX,_EAX: LongWord;

FamilyID, ExtFamilyID, ModelID, ExtModelID, ProcType, Stepping: LongWord;

begin

// get Family, Model and Stepping of CPU

Result:='';

if not IsCPUID_Available then begin

Result := 'CPUID not supported';

Exit;

end;

// steppings are stored at $00000001 "offset"

GetCPUID($00000001,Registers);

Stepping := (Registers.EAX shr 0 ) and $0F;

ModelID := (Registers.EAX shr 4 ) and $0F;

FamilyID := (Registers.EAX shr 8 ) and $0F;

ProcType := (Registers.EAX shr 12) and $03;

ExtModelID := (Registers.EAX shr 16) and $0F;

ExtFamilyID := (Registers.EAX shr 20) and $FF;

Result := Result + Format('Family %x(%x), Model %x(%x), ID %x, Stepping %x',

[FamilyID, ExtFamilyID, ModelID, ExtModelID,

ProcType, Stepping] )

end;

function GetCPUUsage: real;

type

SYSTEM_BASIC_INFORMATION = {$IFDEF WIN32}packed {$ENDIF} record

AlwaysZero : ULONG;

uKeMaximumIncrement : ULONG;

uPageSize : ULONG;

uMmNumberOfPhysicalPages : ULONG;

uMmLowestPhysicalPage : ULONG;

uMmHighestPhysicalPage : ULONG;

uAllocationGranularity : ULONG;

pLowestUserAddress : POINTER;

pMmHighestUserAddress : POINTER;

uKeActiveProcessors : POINTER;

bKeNumberProcessors : byte;

Filler : array [0..2] of byte;

end;

SYSTEM_TIME_INFORMATION = {$IFDEF WIN32}packed {$ENDIF} record

nKeBootTime : int64;

nKeSystemTime : int64;

nExpTimeZoneBias : int64;

uCurrentTimeZoneId : ULONG;

dwReserved : DWORD;

end;

SYSTEM_PERFORMANCE_INFORMATION = {$IFDEF WIN32}packed {$ENDIF} record

nIdleTime : int64;

dwSpare : array [0..75] of DWORD;

end;

const

SystemBasicInformation = 0;

SystemTimeOfDayInformation = 3;

SystemPerformanceInformation = 2;

var

SBI : SYSTEM_BASIC_INFORMATION;

STI : SYSTEM_TIME_INFORMATION;

SPI : SYSTEM_PERFORMANCE_INFORMATION;

ERROR_CODE: cardinal;

dummy : DWORD;

begin

result := -1.0;

ERROR_CODE := NTQuerySystemInformation (SystemBasicInformation,

@SBI,

SizeOf (SYSTEM_BASIC_INFORMATION),

dummy);

if ERROR_CODE <> NO_ERROR then exit;

ERROR_CODE := NTQuerySystemInformation (SystemTimeOfDayInformation,

@STI,

SizeOf (SYSTEM_TIME_INFORMATION),

dummy);

if ERROR_CODE <> NO_ERROR then exit;

ERROR_CODE := NTQuerySystemInformation (SystemPerformanceInformation,

@SPI,

SizeOf (SYSTEM_PERFORMANCE_INFORMATION),

dummy);

if ERROR_CODE <> NO_ERROR then exit;

if (nOldIdleTime <> 0) then

begin

nNewCPUTime := 1.0 -

(SPI.nIdleTime - nOldIdleTime) /

( (STI.nKeSystemTime - nOldSystemTime) * SBI.bKeNumberProcessors ) ;

if (nNewCPUTime <> nOldIdleTime) then

result := nNewCPUTIME;

if result < 0.0 then result := 0.0;

end;

nOldIdleTime := SPI.nIdleTime;

nOldSystemTime := STI.nKeSystemTime;

end;

function GetProcessMem: Integer;

var cb: cardinal;

ProcHandle : THandle;

i: integer;

CurrUsage: double;

begin

/// add Winapi.PsAPI to "uses" list

/// pmc: PPROCESS_MEMORY_COUNTERS; declared as global var

///

/// add to initialization code

/// *******

/// cb := SizeOf(_PROCESS_MEMORY_COUNTERS);

/// GetMem(pmc, cb);

/// pmc^.cb := cb;

/// ****

cb := SizeOf(_PROCESS_MEMORY_COUNTERS);

if pmc = nil then begin

GetMem(pmc, cb);

pmc^.cb := cb;

end;

ProcHandle := GetCurrentProcess();

if GetProcessMemoryInfo( ProcHandle, pmc, cb) then

result := pmc^.WorkingSetSize

else

Result := -1;

end;

end.

推荐分享