Comment faire pour récupérer l'utilisation du processeur par processus

Question

Il existe une plate-forme PerformanceCounter dans .net, qui peut récupérer l'utilisation du processeur de chaque processus unique.

Existe-t-il une solution similaire dans Delphi?

Notez que les noms de tous les processus sont déjà disponibles.

Answer 1

This article semble fournir le code dont vous avez besoin pour surveiller l'utilisation du processeur pour un processus utilisant Delphi natif. Ce qui suit est une citation directe de l'article ci-dessus.

Utilisation de l'appareil

Lors du démarrage de surveiller un processus, appeler cnt: = wsCreateUsageCounter (PROCESS_ID) pour initialiser un compteur d'utilisation. Lorsque vous devez connaître l'utilisation actuelle du processeur pour ce processus, utilisez usage: = wsGetCpuUsage (cnt). Lorsque vous avez terminé la surveillance du processus , appelez wsDestroyUsageCounter (cnt) pour libérer la mémoire utilisée par le compteur d'utilisation et fermer les poignées ouvertes.

L'unité 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. 

Answer 2

Procurez-vous une liste des processus en cours d'exécution:

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; 

Ensuite, il suffit de vérifier l'utilisation pour chaque processus. Je ne suis au courant d'aucune autre option prise en charge directement par le système d'exploitation ou Delphi d'ailleurs.

Answer 3

Vous ne pouvez pas utiliser l'API WMI?

Answer 4

Voir ci-dessous mon unité de PerfUtils. Vous aurez besoin d'une traduction Delphi de Winperf.h, vous pouvez utiliser WinPerf.pas de Marcel van Brakel ou JwaWinPerf.pas du JEDI API Library. Jetez un oeil à la fonction GetProcessPercentProcessorTime.

Exemple d'utilisation:

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.