代码之家  ›  专栏  ›  技术社区  ›  stanleyxu2005

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

cpu-usage delphi
  •  13
  • stanleyxu2005  · 技术社区  · 15 年前

    有一个 PerformanceCounter 在.net平台中,它可以检索每个进程的cpu使用情况。

    delphi中有类似的解决方案吗?

    请注意,所有进程的名称都已可用。

    4 回复  |  直到 10 年前
        1
  •  13
  •   J...    9 年前

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

    使用该单元

    开始监视进程时,请调用 cnt:=wsCreateUsageCounter(进程id),用于初始化使用计数器。 用法:=wsGetCpuUsage(cnt)。当您完成对 顶住并关闭打开的手柄。

    使用单位 

    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.
        2
  •  4
  •   Ondrej Kelle    15 年前

    WinPerf.pas 来自Marcel van Brakel或 JwaWinPerf.pas 从 JEDI API Library 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;

    香水: 

    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.
        3
  •  3
  •   helder    15 年前

    你不能使用wmi api吗?

        4
  •  -3
  •   Runner    15 年前

    只需获取正在运行的进程列表: 

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

    推荐文章
    ByiProX  ·  使用hexo部署我的博客时,macbookpro的CPU使用率非常高
    7 年前
    Lue  ·  慈善机构如何衡量捐赠的CPU使用率?
    7 年前
    van neilsen  ·  优化读取自。gz文件和cpu利用率python
    7 年前
    Cosmin Ioniță  ·  MPI:处理器在单个MPI进程上不能达到100%
    7 年前
    KWMuller  ·  如何在Netbeans中访问调用计数?
    7 年前
    jim crown  ·  调用字符串。导致高cpu的连接未显示在cpu使用率选项卡中
    7 年前
    gunit  ·  谷歌计算引擎上的1个vCPU基本上是1个物理CPU核心的一半吗?
    7 年前
    Daan11  ·  macOS和CentOS上带有doSNOW群集的并行插入符号
    7 年前
    BigPino  ·  改进ExecutorService以在超过1个cpu上执行进程
    9 年前
    Cormac McCann  ·  Sails js应用程序将CPU使用率提高到100%
    9 年前
    关于   移动版
    代码之家 - 一站式码农服务社区
    沪ICP备11025650号