这篇文章提供了使用本地 Delphi 监控进程 CPU 使用情况所需的代码。以下是引用自上述文章的直接引用。
使用该单元
当开始监视一个进程时,请调用cnt:=wsCreateUsageCounter(Process_id)来初始化使用计数器。 当需要获取该进程的当前 CPU 使用情况时,请使用usage:=wsGetCpuUsage(cnt)。当您完成监视过程时,请调用wsDestroyUsageCounter(cnt)释放使用计数器和关闭打开的句柄占用的内存。
uCpuUsage 单元
unit uCpuUsage;
interface
const
wsMinMeasurementInterval=250; {minimum amount of time that must have elapsed to calculate CPU usage, miliseconds. If time elapsed is less than this, previous result is returned, or zero, if there is no previous result.}
type
TCPUUsageData=record
PID,Handle:cardinal;
oldUser,oldKernel:Int64;
LastUpdateTime:cardinal;
LastUsage:single;
//Last result of wsGetCpuUsage is saved here
Tag:cardinal;
//Use it for anythin you like, not modified by this unit
end;
PCPUUsageData=^TCPUUsageData;
function wsCreateUsageCounter(PID:cardinal):PCPUUsageData;
function wsGetCpuUsage(aCounter:PCPUUsageData):single;
procedure wsDestroyUsageCounter(aCounter:PCPUUsageData);
implementation
uses Windows;
function wsCreateUsageCounter(PID:cardinal):PCPUUsageData;
var
p:PCPUUsageData;
mCreationTime,mExitTime,mKernelTime, mUserTime:_FILETIME;
h:cardinal;
begin
result:=nil;
//We need a handle with PROCESS_QUERY_INFORMATION privileges
h:=OpenProcess(PROCESS_QUERY_INFORMATION,false,PID);
if h=0 then exit;
new(p);
p.PID:=PID;
p.Handle:=h;
p.LastUpdateTime:=GetTickCount;
p.LastUsage:=0;
if GetProcessTimes(p.Handle, mCreationTime, mExitTime, mKernelTime, mUserTime) then begin
//convert _FILETIME to Int64
p.oldKernel:=int64(mKernelTime.dwLowDateTime or (mKernelTime.dwHighDateTime shr 32));
p.oldUser:=int64(mUserTime.dwLowDateTime or (mUserTime.dwHighDateTime shr 32));
Result:=p;
end else begin
dispose(p);
end;
end;
procedure wsDestroyUsageCounter(aCounter:PCPUUsageData);
begin
CloseHandle(aCounter.Handle);
dispose(aCounter);
end;
function wsGetCpuUsage(aCounter:PCPUUsageData):single;
var
mCreationTime,mExitTime,mKernelTime, mUserTime:_FILETIME;
DeltaMs,ThisTime:cardinal;
mKernel,mUser,mDelta:int64;
begin
result:=aCounter.LastUsage;
ThisTime:=GetTickCount; //Get the time elapsed since last query
DeltaMs:=ThisTime-aCounter.LastUpdateTime;
if DeltaMs < wsMinMeasurementInterval then exit;
aCounter.LastUpdateTime:=ThisTime;
GetProcessTimes(aCounter.Handle,mCreationTime, mExitTime, mKernelTime, mUserTime);
//convert _FILETIME to Int64.
mKernel:=int64(mKernelTime.dwLowDateTime or (mKernelTime.dwHighDateTime shr 32));
mUser:=int64(mUserTime.dwLowDateTime or (mUserTime.dwHighDateTime shr 32));
//get the delta
mDelta:=mUser+mKernel-aCounter.oldUser-aCounter.oldKernel;
aCounter.oldUser:=mUser;
aCounter.oldKernel:=mKernel;
Result:=(mDelta/DeltaMs)/100;
//mDelta is in units of 100 nanoseconds, so…
aCounter.LastUsage:=Result;
//just in case you want to use it later, too
end;
end.
var
Data1, Data2: PPerfDataBlock;
ProcessorCount: Integer;
PercentProcessorTime: Double;
begin
ProcessorCount := GetProcessorCount;
Data1 := GetPerformanceData(IntToStr(ObjProcess));
Sleep(1000);
Data2 := GetPerformanceData(IntToStr(ObjProcess));
PercentProcessorTime := GetProcessPercentProcessorTime(ProcessID, Data1, Data2, ProcessorCount);
// ...
end;
PerfUtils.pas:
unit PerfUtils;
interface
uses
Windows, SysUtils,
WinPerf;
type
PPerfLibHeader = ^TPerfLibHeader;
TPerfLibHeader = packed record
Signature: array[0..7] of Char;
DataSize: Cardinal;
ObjectCount: Cardinal;
end;
function GetCounterBlock(Obj: PPerfObjectType): PPerfCounterBlock; overload;
function GetCounterBlock(Instance: PPerfInstanceDefinition): PPerfCounterBlock; overload;
function GetCounterDataAddress(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): Pointer; overload;
function GetCounterDataAddress(Obj: PPerfObjectType; Counter, Instance: Integer): Pointer; overload;
function GetCounter(Obj: PPerfObjectType; Index: Integer): PPerfCounterDefinition;
function GetCounterByNameIndex(Obj: PPerfObjectType; NameIndex: Cardinal): PPerfCounterDefinition;
function GetCounterValue32(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): Cardinal;
function GetCounterValue64(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): UInt64;
function GetCounterValueText(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): PChar;
function GetCounterValueWideText(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): PWideChar;
function GetFirstCounter(Obj: PPerfObjectType): PPerfCounterDefinition;
function GetFirstInstance(Obj: PPerfObjectType): PPerfInstanceDefinition;
function GetFirstObject(Data: PPerfDataBlock): PPerfObjectType; overload;
function GetFirstObject(Header: PPerfLibHeader): PPerfObjectType; overload;
function GetInstance(Obj: PPerfObjectType; Index: Integer): PPerfInstanceDefinition;
function GetInstanceName(Instance: PPerfInstanceDefinition): PWideChar;
function GetNextCounter(Counter: PPerfCounterDefinition): PPerfCounterDefinition;
function GetNextInstance(Instance: PPerfInstanceDefinition): PPerfInstanceDefinition;
function GetNextObject(Obj: PPerfObjectType): PPerfObjectType;
function GetObjectSize(Obj: PPerfObjectType): Cardinal;
function GetObject(Data: PPerfDataBlock; Index: Integer): PPerfObjectType; overload;
function GetObject(Header: PPerfLibHeader; Index: Integer): PPerfObjectType; overload;
function GetObjectByNameIndex(Data: PPerfDataBlock; NameIndex: Cardinal): PPerfObjectType; overload;
function GetObjectByNameIndex(Header: PPerfLibHeader; NameIndex: Cardinal): PPerfObjectType; overload;
function GetPerformanceData(const RegValue: string): PPerfDataBlock;
function GetProcessInstance(Obj: PPerfObjectType; ProcessID: Cardinal): PPerfInstanceDefinition;
function GetSimpleCounterValue32(ObjIndex, CtrIndex: Integer): Cardinal;
function GetSimpleCounterValue64(ObjIndex, CtrIndex: Integer): UInt64;
function GetProcessName(ProcessID: Cardinal): WideString;
function GetProcessPercentProcessorTime(ProcessID: Cardinal; Data1, Data2: PPerfDataBlock;
ProcessorCount: Integer = -1): Double;
function GetProcessPrivateBytes(ProcessID: Cardinal): UInt64;
function GetProcessThreadCount(ProcessID: Cardinal): Cardinal;
function GetProcessVirtualBytes(ProcessID: Cardinal): UInt64;
function GetProcessorCount: Integer;
function GetSystemProcessCount: Cardinal;
function GetSystemUpTime: TDateTime;
var
PerfFrequency: Int64 = 0;
const
// perfdisk.dll
ObjPhysicalDisk = 234;
ObjLogicalDisk = 236;
// perfnet.dll
ObjBrowser = 52;
ObjRedirector = 262;
ObjServer = 330;
ObjServerWorkQueues = 1300;
// perfos.dll
ObjSystem = 2;
CtrProcesses = 248;
CtrSystemUpTime = 674;
ObjMemory = 4;
ObjCache = 86;
ObjProcessor = 238;
ObjObjects = 260;
ObjPagingFile = 700;
// perfproc.dll
ObjProcess = 230;
CtrPercentProcessorTime = 6;
CtrVirtualBytes = 174;
CtrPrivateBytes = 186;
CtrThreadCount = 680;
CtrIDProcess = 784;
ObjThread = 232;
ObjProcessAddressSpace = 786;
ObjImage = 740;
ObjThreadDetails = 816;
ObjFullImage = 1408;
ObjJobObject = 1500;
ObjJobObjectDetails = 1548;
ObjHeap = 1760;
// winspool.drv
ObjPrintQueue = 1450;
// tapiperf.dll
ObjTelephony = 1150;
// perfctrs.dll
ObjNBTConnection = 502;
ObjNetworkInterface = 510;
ObjIP = 546;
ObjICMP = 582;
ObjTCP = 638;
ObjUDP = 658;
implementation
function GetCounterBlock(Obj: PPerfObjectType): PPerfCounterBlock;
begin
if Assigned(Obj) and (Obj^.NumInstances = PERF_NO_INSTANCES) then
Cardinal(Result) := Cardinal(Obj) + SizeOf(TPerfObjectType) + (Obj^.NumCounters * SizeOf(TPerfCounterDefinition))
else
Result := nil;
end;
function GetCounterBlock(Instance: PPerfInstanceDefinition): PPerfCounterBlock;
begin
if Assigned(Instance) then
Cardinal(Result) := Cardinal(Instance) + Instance^.ByteLength
else
Result := nil;
end;
function GetCounterDataAddress(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): Pointer;
var
Block: PPerfCounterBlock;
begin
Result := nil;
if not Assigned(Obj) or not Assigned(Counter) then
Exit;
if Obj^.NumInstances = PERF_NO_INSTANCES then
Block := GetCounterBlock(Obj)
else
begin
if not Assigned(Instance) then
Exit;
Block := GetCounterBlock(Instance);
end;
if not Assigned(Block) then
Exit;
Cardinal(Result) := Cardinal(Block) + Counter^.CounterOffset;
end;
function GetCounterDataAddress(Obj: PPerfObjectType; Counter, Instance: Integer): Pointer;
begin
Result := nil;
if not Assigned(Obj) or (Counter < 0) or (Cardinal(Counter) > Obj^.NumCounters - 1) then
Exit;
if Obj^.NumInstances = PERF_NO_INSTANCES then
begin
if Instance <> -1 then
Exit;
end
else
begin
if (Instance < 0) or (Instance > Obj^.NumInstances - 1) then
Exit;
end;
Result := GetCounterDataAddress(Obj, GetCounter(Obj, Counter), GetInstance(Obj, Instance));
end;
function GetCounter(Obj: PPerfObjectType; Index: Integer): PPerfCounterDefinition;
var
I: Integer;
begin
if Assigned(Obj) and (Index >= 0) and (Cardinal(Index) <= Obj^.NumCounters - 1) then
begin
Result := GetFirstCounter(Obj);
if not Assigned(Result) then
Exit;
for I := 0 to Index - 1 do
begin
Result := GetNextCounter(Result);
if not Assigned(Result) then
Exit;
end;
end
else
Result := nil;
end;
function GetCounterByNameIndex(Obj: PPerfObjectType; NameIndex: Cardinal): PPerfCounterDefinition;
var
Counter: PPerfCounterDefinition;
I: Integer;
begin
Result := nil;
Counter := GetFirstCounter(Obj);
for I := 0 to Obj^.NumCounters - 1 do
begin
if not Assigned(Counter) then
Exit;
if Counter^.CounterNameTitleIndex = NameIndex then
begin
Result := Counter;
Break;
end;
Counter := GetNextCounter(Counter);
end;
end;
function GetCounterValue32(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): Cardinal;
var
DataAddr: Pointer;
begin
Result := 0;
DataAddr := GetCounterDataAddress(Obj, Counter, Instance);
if not Assigned(DataAddr) then
Exit;
if Counter^.CounterType and $00000300 = PERF_SIZE_DWORD then // 32-bit value
case Counter^.CounterType and $00000C00 of // counter type
PERF_TYPE_NUMBER, PERF_TYPE_COUNTER:
Result := PCardinal(DataAddr)^;
end;
end;
function GetCounterValue64(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): UInt64;
var
DataAddr: Pointer;
begin
Result := 0;
DataAddr := GetCounterDataAddress(Obj, Counter, Instance);
if not Assigned(DataAddr) then
Exit;
if Counter^.CounterType and $00000300 = PERF_SIZE_LARGE then // 64-bit value
case Counter^.CounterType and $00000C00 of // counter type
PERF_TYPE_NUMBER, PERF_TYPE_COUNTER:
Result := Uint64(PInt64(DataAddr)^);
end;
end;
function GetCounterValueText(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): PChar;
var
DataAddr: Pointer;
begin
Result := nil;
DataAddr := GetCounterDataAddress(Obj, Counter, Instance);
if not Assigned(DataAddr) then
Exit;
if Counter^.CounterType and $00000300 = PERF_SIZE_VARIABLE_LEN then // variable-length value
if (Counter^.CounterType and $00000C00 = PERF_TYPE_TEXT) and
(Counter^.CounterType and $00010000 = PERF_TEXT_ASCII) then
Result := PChar(DataAddr);
end;
function GetCounterValueWideText(Obj: PPerfObjectType; Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition = nil): PWideChar;
var
DataAddr: Pointer;
begin
Result := nil;
DataAddr := GetCounterDataAddress(Obj, Counter, Instance);
if not Assigned(DataAddr) then
Exit;
if Counter^.CounterType and $00000300 = PERF_SIZE_VARIABLE_LEN then // variable-length value
if (Counter^.CounterType and $00000C00 = PERF_TYPE_TEXT) and
(Counter^.CounterType and $00010000 = PERF_TEXT_UNICODE) then
Result := PWideChar(DataAddr);
end;
function GetFirstCounter(Obj: PPerfObjectType): PPerfCounterDefinition;
begin
if Assigned(Obj) then
Cardinal(Result) := Cardinal(Obj) + Obj^.HeaderLength
else
Result := nil;
end;
function GetFirstInstance(Obj: PPerfObjectType): PPerfInstanceDefinition;
begin
if not Assigned(Obj) or (Obj^.NumInstances = PERF_NO_INSTANCES) then
Result := nil
else
Cardinal(Result) := Cardinal(Obj) + SizeOf(TPerfObjectType) + (Obj^.NumCounters * SizeOf(TPerfCounterDefinition));
end;
function GetFirstObject(Data: PPerfDataBlock): PPerfObjectType; overload;
begin
if Assigned(Data) then
Cardinal(Result) := Cardinal(Data) + Data^.HeaderLength
else
Result := nil;
end;
function GetFirstObject(Header: PPerfLibHeader): PPerfObjectType; overload;
begin
if Assigned(Header) then
Cardinal(Result) := Cardinal(Header) + SizeOf(TPerfLibHeader)
else
Result := nil;
end;
function GetInstance(Obj: PPerfObjectType; Index: Integer): PPerfInstanceDefinition;
var
I: Integer;
begin
if Assigned(Obj) and (Index >= 0) and (Index <= Obj^.NumInstances - 1) then
begin
Result := GetFirstInstance(Obj);
if not Assigned(Result) then
Exit;
for I := 0 to Index - 1 do
begin
Result := GetNextInstance(Result);
if not Assigned(Result) then
Exit;
end;
end
else
Result := nil;
end;
function GetInstanceName(Instance: PPerfInstanceDefinition): PWideChar;
begin
if Assigned(Instance) then
Cardinal(Result) := Cardinal(Instance) + Instance^.NameOffset
else
Result := nil;
end;
function GetNextCounter(Counter: PPerfCounterDefinition): PPerfCounterDefinition;
begin
if Assigned(Counter) then
Cardinal(Result) := Cardinal(Counter) + Counter^.ByteLength
else
Result := nil;
end;
function GetNextInstance(Instance: PPerfInstanceDefinition): PPerfInstanceDefinition;
var
Block: PPerfCounterBlock;
begin
Block := GetCounterBlock(Instance);
if Assigned(Block) then
Cardinal(Result) := Cardinal(Block) + Block^.ByteLength
else
Result := nil;
end;
function GetNextObject(Obj: PPerfObjectType): PPerfObjectType;
begin
if Assigned(Obj) then
Cardinal(Result) := Cardinal(Obj) + Obj^.TotalByteLength
else
Result := nil;
end;
function GetObjectSize(Obj: PPerfObjectType): Cardinal;
var
I: Integer;
Instance: PPerfInstanceDefinition;
begin
Result := 0;
if Assigned(Obj) then
begin
if Obj^.NumInstances = PERF_NO_INSTANCES then
Result := Obj^.TotalByteLength
else
begin
Instance := GetFirstInstance(Obj);
if not Assigned(Instance) then
Exit;
for I := 0 to Obj^.NumInstances - 1 do
begin
Instance := GetNextInstance(Instance);
if not Assigned(Instance) then
Exit;
end;
Result := Cardinal(Instance) - Cardinal(Obj);
end;
end;
end;
function GetObject(Data: PPerfDataBlock; Index: Integer): PPerfObjectType;
var
I: Integer;
begin
if Assigned(Data) and (Index >= 0) and (Cardinal(Index) <= Data^.NumObjectTypes - 1) then
begin
Result := GetFirstObject(Data);
if not Assigned(Result) then
Exit;
for I := 0 to Index - 1 do
begin
Result := GetNextObject(Result);
if not Assigned(Result) then
Exit;
end;
end
else
Result := nil;
end;
function GetObject(Header: PPerfLibHeader; Index: Integer): PPerfObjectType;
var
I: Integer;
begin
if Assigned(Header) and (Index >= 0) then
begin
Result := GetFirstObject(Header);
if not Assigned(Result) then
Exit;
for I := 0 to Index - 1 do
begin
Result := GetNextObject(Result);
if not Assigned(Result) then
Exit;
end;
end
else
Result := nil;
end;
function GetObjectByNameIndex(Data: PPerfDataBlock; NameIndex: Cardinal): PPerfObjectType;
var
Obj: PPerfObjectType;
I: Integer;
begin
Result := nil;
Obj := GetFirstObject(Data);
for I := 0 to Data^.NumObjectTypes - 1 do
begin
if not Assigned(Obj) then
Exit;
if Obj^.ObjectNameTitleIndex = NameIndex then
begin
Result := Obj;
Break;
end;
Obj := GetNextObject(Obj);
end;
end;
function GetObjectByNameIndex(Header: PPerfLibHeader; NameIndex: Cardinal): PPerfObjectType; overload;
var
Obj: PPerfObjectType;
I: Integer;
begin
Result := nil;
Obj := GetFirstObject(Header);
for I := 0 to Header^.ObjectCount - 1 do
begin
if not Assigned(Obj) then
Exit;
if Obj^.ObjectNameTitleIndex = NameIndex then
begin
Result := Obj;
Break;
end;
Obj := GetNextObject(Obj);
end;
end;
function GetPerformanceData(const RegValue: string): PPerfDataBlock;
const
BufSizeInc = 4096;
var
BufSize, RetVal: Cardinal;
begin
BufSize := BufSizeInc;
Result := AllocMem(BufSize);
try
RetVal := RegQueryValueEx(HKEY_PERFORMANCE_DATA, PChar(RegValue), nil, nil, PByte(Result), @BufSize);
try
repeat
case RetVal of
ERROR_SUCCESS:
Break;
ERROR_MORE_DATA:
begin
Inc(BufSize, BufSizeInc);
ReallocMem(Result, BufSize);
RetVal := RegQueryValueEx(HKEY_PERFORMANCE_DATA, PChar(RegValue), nil, nil, PByte(Result), @BufSize);
end;
else
RaiseLastOSError;
end;
until False;
finally
RegCloseKey(HKEY_PERFORMANCE_DATA);
end;
except
FreeMem(Result);
raise;
end;
end;
function GetProcessInstance(Obj: PPerfObjectType; ProcessID: Cardinal): PPerfInstanceDefinition;
var
Counter: PPerfCounterDefinition;
Instance: PPerfInstanceDefinition;
Block: PPerfCounterBlock;
I: Integer;
begin
Result := nil;
Counter := GetCounterByNameIndex(Obj, CtrIDProcess);
if not Assigned(Counter) then
Exit;
Instance := GetFirstInstance(Obj);
for I := 0 to Obj^.NumInstances - 1 do
begin
Block := GetCounterBlock(Instance);
if not Assigned(Block) then
Exit;
if PCardinal(Cardinal(Block) + Counter^.CounterOffset)^ = ProcessID then
begin
Result := Instance;
Break;
end;
Instance := GetNextInstance(Instance);
end;
end;
function GetSimpleCounterValue32(ObjIndex, CtrIndex: Integer): Cardinal;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
Counter: PPerfCounterDefinition;
begin
Result := 0;
Data := GetPerformanceData(IntToStr(ObjIndex));
try
Obj := GetObjectByNameIndex(Data, ObjIndex);
if not Assigned(Obj) then
Exit;
Counter := GetCounterByNameIndex(Obj, CtrIndex);
if not Assigned(Counter) then
Exit;
Result := GetCounterValue32(Obj, Counter);
finally
FreeMem(Data);
end;
end;
function GetSimpleCounterValue64(ObjIndex, CtrIndex: Integer): UInt64;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
Counter: PPerfCounterDefinition;
begin
Result := 0;
Data := GetPerformanceData(IntToStr(ObjIndex));
try
Obj := GetObjectByNameIndex(Data, ObjIndex);
if not Assigned(Obj) then
Exit;
Counter := GetCounterByNameIndex(Obj, CtrIndex);
if not Assigned(Counter) then
Exit;
Result := GetCounterValue64(Obj, Counter);
finally
FreeMem(Data);
end;
end;
function GetProcessName(ProcessID: Cardinal): WideString;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
Instance: PPerfInstanceDefinition;
begin
Result := '';
Data := GetPerformanceData(IntToStr(ObjProcess));
try
Obj := GetObjectByNameIndex(Data, ObjProcess);
if not Assigned(Obj) then
Exit;
Instance := GetProcessInstance(Obj, ProcessID);
if not Assigned(Instance) then
Exit;
Result := GetInstanceName(Instance);
finally
FreeMem(Data);
end;
end;
function GetProcessPercentProcessorTime(ProcessID: Cardinal; Data1, Data2: PPerfDataBlock;
ProcessorCount: Integer): Double;
var
Value1, Value2: UInt64;
function GetValue(Data: PPerfDataBlock): UInt64;
var
Obj: PPerfObjectType;
Instance: PPerfInstanceDefinition;
Counter: PPerfCounterDefinition;
begin
Result := 0;
Obj := GetObjectByNameIndex(Data, ObjProcess);
if not Assigned(Obj) then
Exit;
Counter := GetCounterByNameIndex(Obj, CtrPercentProcessorTime);
if not Assigned(Counter) then
Exit;
Instance := GetProcessInstance(Obj, ProcessID);
if not Assigned(Instance) then
Exit;
Result := GetCounterValue64(Obj, Counter, Instance);
end;
begin
if ProcessorCount = -1 then
ProcessorCount := GetProcessorCount;
Value1 := GetValue(Data1);
Value2 := GetValue(Data2);
Result := 100 * (Value2 - Value1) / (Data2^.PerfTime100nSec.QuadPart - Data1^.PerfTime100nSec.QuadPart)
/ ProcessorCount;
end;
function GetProcessPrivateBytes(ProcessID: Cardinal): UInt64;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
Instance: PPerfInstanceDefinition;
Counter: PPerfCounterDefinition;
begin
Result := 0;
Data := GetPerformanceData(IntToStr(ObjProcess));
try
Obj := GetObjectByNameIndex(Data, ObjProcess);
if not Assigned(Obj) then
Exit;
Counter := GetCounterByNameIndex(Obj, CtrPrivateBytes);
if not Assigned(Counter) then
Exit;
Instance := GetProcessInstance(Obj, ProcessID);
if not Assigned(Instance) then
Exit;
Result := GetCounterValue64(Obj, Counter, Instance);
finally
FreeMem(Data);
end;
end;
function GetProcessThreadCount(ProcessID: Cardinal): Cardinal;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
Instance: PPerfInstanceDefinition;
Counter: PPerfCounterDefinition;
begin
Result := 0;
Data := GetPerformanceData(IntToStr(ObjProcess));
try
Obj := GetObjectByNameIndex(Data, ObjProcess);
if not Assigned(Obj) then
Exit;
Counter := GetCounterByNameIndex(Obj, CtrThreadCount);
if not Assigned(Counter) then
Exit;
Instance := GetProcessInstance(Obj, ProcessID);
if not Assigned(Instance) then
Exit;
Result := GetCounterValue32(Obj, Counter, Instance);
finally
FreeMem(Data);
end;
end;
function GetProcessVirtualBytes(ProcessID: Cardinal): UInt64;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
Instance: PPerfInstanceDefinition;
Counter: PPerfCounterDefinition;
begin
Result := 0;
Data := GetPerformanceData(IntToStr(ObjProcess));
try
Obj := GetObjectByNameIndex(Data, ObjProcess);
if not Assigned(Obj) then
Exit;
Counter := GetCounterByNameIndex(Obj, CtrVirtualBytes);
if not Assigned(Counter) then
Exit;
Instance := GetProcessInstance(Obj, ProcessID);
if not Assigned(Instance) then
Exit;
Result := GetCounterValue64(Obj, Counter, Instance);
finally
FreeMem(Data);
end;
end;
function GetProcessorCount: Integer;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
begin
Result := -1;
Data := GetPerformanceData(IntToStr(ObjProcessor));
try
Obj := GetFirstObject(Data);
if not Assigned(Obj) then
Exit;
Result := Obj^.NumInstances;
if Result > 1 then // disregard the additional '_Total' instance
Dec(Result);
finally
FreeMem(Data);
end;
end;
function GetSystemProcessCount: Cardinal;
begin
Result := GetSimpleCounterValue32(ObjSystem, CtrProcesses);
end;
function GetSystemUpTime: TDateTime;
const
SecsPerDay = 60 * 60 * 24;
var
Data: PPerfDataBlock;
Obj: PPerfObjectType;
Counter: PPerfCounterDefinition;
SecsStartup: UInt64;
begin
Result := 0;
Data := GetPerformanceData(IntToStr(ObjSystem));
try
Obj := GetObjectByNameIndex(Data, ObjSystem);
if not Assigned(Obj) then
Exit;
Counter := GetCounterByNameIndex(Obj, CtrSystemUpTime);
if not Assigned(Counter) then
Exit;
SecsStartup := GetCounterValue64(Obj, Counter);
// subtract from snapshot time and divide by base frequency and number of seconds per day
// to get a TDateTime representation
Result := (Obj^.PerfTime.QuadPart - SecsStartup) / Obj^.PerfFreq.QuadPart / SecsPerDay;
finally
FreeMem(Data);
end;
end;
initialization
QueryPerformanceFrequency(PerfFrequency);
finalization
end.
你不能使用wmi api吗?
获取正在运行的进程列表:
procedure TForm1.Button1Click(Sender: TObject);
var
handler: THandle;
data: TProcessEntry32;
function GetName: string;
var i:byte;
begin
Result := '';
i := 0;
while data.szExeFile[i] <> '' do
begin
Result := Result + data.szExeFile[i];
Inc(i);
end;
end;
begin
handler := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
if Process32First(handler, data) then
begin
listbox1.Items.Add(GetName());
while Process32Next(handler, data) do
listbox1.Items.Add(GetName());
end
else
ShowMessage('Error');
end;
然后只需检查每个进程的使用情况。 就我所知,操作系统或Delphi本身没有任何其他直接支持的选项。