Question

На платформе .net имеется PerformanceCounter , который может извлекать информацию об использовании ЦП каждым процессом.

Есть ли подобное решение в delphi?

Обратите внимание, что имена всех процессов уже доступны.

J__ · Answer 1 · 10 ноября 2009

Эта статья содержит код, необходимый для мониторинга использования процессора для процесса, использующего собственный Delphi. Далее следует прямая цитата из вышеприведенной статьи.

Использование устройства

При запуске мониторинга процесса позвоните cnt: = wsCreateUsageCounter (Process_id) для инициализации счетчика использования. Когда вам нужно узнать текущее использование процессора этим процессом, используйте Использование: = 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.

Ondrej Kelle · Answer 2 · 12 ноября 2009

Смотрите ниже мой блок PerfUtils. Вам понадобится Delphi-перевод Winperf.h, вы можете использовать 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;

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.

Runner · Answer 3 · 10 ноября 2009

Просто получите список запущенных процессов:

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;

Тогда просто проверьте использование для каждого процесса. Я не знаю ни о каком другом варианте, поддерживаемом непосредственно OS или Delphi в этом отношении.

Как восстановить использование процессора на процесс

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 4 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Как восстановить использование процессора на процесс

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 4 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы