Вопросы Теги

Как получить использование CPU для каждого процесса

Вы не сказали так, но это кажется на запуск Emacs с ярлыка Windows.

каталог, который Вы видите с c-x c-f, является cwd, в терминах Emacs, default-directory (переменная).

то, Когда Вы запускаете Emacs с помощью ярлыка MS Windows, эти default-directory, является первоначально папкой (каталог), определенный в поле "Start In" свойств ярлыка. Щелкните правой кнопкой по ярлыку, выберите Properties и введите путь к Вашему рабочему столу в Start In поле.

, Если Вы используете Emacs из командной строки, default-directory, запускается как каталог, где Вы запустили Emacs (cwd).

Этот подход лучше, чем редактирование Вашего .emacs файла, так как это позволит Вам иметь больше чем один ярлык больше чем с одним начальным каталогом, и это позволяет Вам иметь нормальное поведение командной строки Emacs при необходимости в нем.

CWD = текущий рабочий каталог = PWD = существующий рабочий каталог . Это имеет намного больше смысла в командной строке, чем в GUI.

13
задан AShelly 16 September 2014 в 22:29
поделиться

4 ответа

Эта статья , по всей видимости, предоставляет код, необходимый для отслеживания использования ЦП процессом с использованием собственного 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.
12
ответ дан 2 December 2019 в 00:03
поделиться

Вы не можете использовать wmi api?

3
ответ дан 2 December 2019 в 00:03
поделиться

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

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 в этом отношении.

-3
ответ дан 2 December 2019 в 00:03
поделиться

См. Ниже мой модуль PerfUtils. Вам понадобится Delphi-перевод Winperf.h, вы можете использовать WinPerf.pas от Марселя ван Бракеля или 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.
4
ответ дан 2 December 2019 в 00:03
поделиться
Другие вопросы по тегам:

Похожие вопросы: