如何检索每个进程的CPU使用率

问题描述：

.net平台中有一个PerformanceCounter，它可以检索每个进程的CPU使用情况。如何检索每个进程的CPU使用率

在delphi中有没有类似的解决方案？

请注意，所有进程的名称已经可用。

+1参考如何在.NET中使用的PerformanceCounter :) – 2010-08-05 04:16:24

答

This article似乎提供了监视使用本机Delphi的进程的CPU使用情况所需的代码。以下是上述文章的直接引用。

使用单元

当开始监控过程，呼叫 CNT：= wsCreateUsageCounter（PROCESS_ID）来初始化的使用计数器。当您需要获取该进程的当前CPU使用率时，请使用用法：= 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.

+10

是的，只要确保您计算CPU数量并除以结果即可，否则您将在多核系统上得到错误的百分比：使用Windows; 函数GetCpuCount：Word; var SysInfo：_SYSTEM_INFO; 开始 GetSystemInfo（SysInfo）; 结果：= SysInfo.dwNumberOfProcessors; 结束; – vcldeveloper 2009-11-10 15:07:51

相关提示一个很好的技巧;-) – stanleyxu2005 2009-11-10 20:31:43

答

刚刚获得正在运行的进程的列表：

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直接支持的其他选项。

没有帮助的，不相关 – CyprUS 2012-09-06 13:27:57

答

难道你不能使用wmi api吗？

谢谢你的提示。我在http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_21110830.html上找到了解决方案。在使用此代码之前，必须先生成一个WbemScripting_TLB单元。 – stanleyxu2005 2009-11-10 20:37:16

答

见下面我PerfUtils单元。您需要Winperf.h的Delphi翻译，您可以使用Marcel van Brakel的WinPerf.pas或JEDI API Library的JwaWinPerf.pas。看看GetProcessPercentProcessorTime函数。

用法示例：

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.

我忘了添加，该单位是为Delphi 7编写的，所以如果你想在Delphi 2009或更高版本中使用它，你必须修改它以使它兼容：更改声明以使用AnsiChar而不是Char，PAnsiChar代替PChar等。 – 2009-11-12 09:50:35

如何检索每个进程的CPU使用率

相关推荐