803 lines
22 KiB
ObjectPascal
803 lines
22 KiB
ObjectPascal
{*******************************************************}
|
|
{ MiTeC Common Routines }
|
|
{ Performance Library Utils }
|
|
{ }
|
|
{ Copyright (c) 1997-2016 Michal Mutl }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
{$INCLUDE Compilers.inc}
|
|
|
|
unit MiTeC_PerfUtils;
|
|
|
|
interface
|
|
|
|
uses{$IFDEF RAD9PLUS}
|
|
WinAPI.Windows, System.SysUtils,
|
|
{$ELSE}
|
|
Windows, SysUtils,
|
|
{$ENDIF}
|
|
MiTeC_WinPerf;
|
|
|
|
function GetCounterBlock(AObj: PPerfObjectType): PPerfCounterBlock; overload;
|
|
function GetCounterBlock(AInstance: PPerfInstanceDefinition): PPerfCounterBlock; overload;
|
|
function GetCounterDataAddress(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition = nil): Pointer; overload;
|
|
function GetCounterDataAddress(AObj: PPerfObjectType; ACounter, AInstance: Integer): Pointer; overload;
|
|
function GetCounter(AObj: PPerfObjectType; AIndex: Integer): PPerfCounterDefinition;
|
|
function GetCounterByNameIndex(AObj: PPerfObjectType; ANameIndex: Cardinal): PPerfCounterDefinition;
|
|
function GetCounterValue32(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition = nil): Cardinal;
|
|
function GetCounterValue64(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition = nil): UInt64;
|
|
function GetCounterValueText(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition = nil): PChar;
|
|
function GetCounterValueWideText(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition = nil): PWideChar;
|
|
function GetFirstCounter(AObj: PPerfObjectType): PPerfCounterDefinition;
|
|
function GetFirstInstance(AObj: PPerfObjectType): PPerfInstanceDefinition;
|
|
function GetFirstObject(AData: PPerfDataBlock): PPerfObjectType; overload;
|
|
function GetFirstObject(AHeader: PPerfLibHeader): PPerfObjectType; overload;
|
|
function GetInstance(AObj: PPerfObjectType; aIndex: Integer): PPerfInstanceDefinition;
|
|
function GetInstanceName(AInstance: PPerfInstanceDefinition): PWideChar;
|
|
function GetNextCounter(ACounter: PPerfCounterDefinition): PPerfCounterDefinition;
|
|
function GetNextInstance(AInstance: PPerfInstanceDefinition): PPerfInstanceDefinition;
|
|
function GetNextObject(AObj: PPerfObjectType): PPerfObjectType;
|
|
function GetObjectSize(AObj: PPerfObjectType): Cardinal;
|
|
function GetObject(AData: PPerfDataBlock; AIndex: Integer): PPerfObjectType; overload;
|
|
function GetObject(AHeader: PPerfLibHeader; AIndex: Integer): PPerfObjectType; overload;
|
|
function GetObjectByNameIndex(AData: PPerfDataBlock; ANameIndex: Cardinal): PPerfObjectType; overload;
|
|
function GetObjectByNameIndex(AHeader: PPerfLibHeader; ANameIndex: Cardinal): PPerfObjectType; overload;
|
|
function GetPerformanceData(const ARegValue: string): PPerfDataBlock;
|
|
function GetProcessInstance(AObj: PPerfObjectType; AProcessID: Cardinal): PPerfInstanceDefinition;
|
|
function GetSimpleCounterValue32(AObjIndex, ACtrIndex: Integer): Cardinal;
|
|
function GetSimpleCounterValue64(AObjIndex, ACtrIndex: Integer): UInt64;
|
|
|
|
function GetProcessName(AProcessID: Cardinal): WideString;
|
|
function GetProcessPercentProcessorTime(AProcessID: Cardinal; AData1, AData2: PPerfDataBlock;
|
|
AProcessorCount: Integer = -1): Double;
|
|
function GetProcessPrivateBytes(AProcessID: Cardinal): UInt64;
|
|
function GetProcessThreadCount(AProcessID: Cardinal): Cardinal;
|
|
function GetProcessVirtualBytes(AProcessID: 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(AObj: PPerfObjectType): PPerfCounterBlock;
|
|
begin
|
|
if Assigned(AObj) and (AObj^.NumInstances=PERF_NO_INSTANCES) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AObj)+SizeOf(TPerfObjectType)+(AObj^.NumCounters * SizeOf(TPerfCounterDefinition))
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetCounterBlock(AInstance: PPerfInstanceDefinition): PPerfCounterBlock;
|
|
begin
|
|
if Assigned(AInstance) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AInstance)+AInstance^.ByteLength
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetCounterDataAddress(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition=nil): Pointer;
|
|
var
|
|
Block: PPerfCounterBlock;
|
|
begin
|
|
Result:=nil;
|
|
if not Assigned(AObj) or not Assigned(ACounter) then
|
|
Exit;
|
|
|
|
if AObj^.NumInstances=PERF_NO_INSTANCES then
|
|
Block:=GetCounterBlock(AObj)
|
|
else
|
|
begin
|
|
if not Assigned(AInstance) then
|
|
Exit;
|
|
|
|
Block:=GetCounterBlock(AInstance);
|
|
end;
|
|
|
|
if not Assigned(Block) then
|
|
Exit;
|
|
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Block)+ACounter^.CounterOffset;
|
|
end;
|
|
|
|
function GetCounterDataAddress(AObj: PPerfObjectType; ACounter, AInstance: Integer): Pointer;
|
|
begin
|
|
Result:=nil;
|
|
if not Assigned(AObj) or (ACounter<0) or (Cardinal(ACounter)>AObj^.NumCounters-1) then
|
|
Exit;
|
|
|
|
if AObj^.NumInstances=PERF_NO_INSTANCES then
|
|
begin
|
|
if AInstance <> -1 then
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
if (AInstance>0) or (AInstance>AObj^.NumInstances-1) then
|
|
Exit;
|
|
end;
|
|
|
|
Result:=GetCounterDataAddress(AObj, GetCounter(AObj, ACounter), GetInstance(AObj, AInstance));
|
|
end;
|
|
|
|
function GetCounter(AObj: PPerfObjectType; AIndex: Integer): PPerfCounterDefinition;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Assigned(AObj) and (AIndex >= 0) and (Cardinal(AIndex) <= AObj^.NumCounters-1) then begin
|
|
Result:=GetFirstCounter(AObj);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
|
|
for I:=0 to AIndex-1 do begin
|
|
Result:=GetNextCounter(Result);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
end;
|
|
end else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetCounterByNameIndex(AObj: PPerfObjectType; ANameIndex: Cardinal): PPerfCounterDefinition;
|
|
var
|
|
Counter: PPerfCounterDefinition;
|
|
I: Integer;
|
|
begin
|
|
Result:=nil;
|
|
|
|
Counter:=GetFirstCounter(AObj);
|
|
for I:=0 to AObj^.NumCounters-1 do begin
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
if Counter^.CounterNameTitleIndex=ANameIndex then begin
|
|
Result:=Counter;
|
|
Break;
|
|
end;
|
|
|
|
Counter:=GetNextCounter(Counter);
|
|
end;
|
|
end;
|
|
|
|
function GetCounterValue32(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition=nil): Cardinal;
|
|
var
|
|
DataAddr: Pointer;
|
|
begin
|
|
Result:=0;
|
|
|
|
DataAddr:=GetCounterDataAddress(AObj, ACounter, AInstance);
|
|
if not Assigned(DataAddr) then
|
|
Exit;
|
|
|
|
if ACounter^.CounterType and $00000300=PERF_SIZE_DWORD then // 32-bit value
|
|
case ACounter^.CounterType and $00000C00 of // counter type
|
|
PERF_TYPE_NUMBER, PERF_TYPE_COUNTER:
|
|
Result:=PCardinal(DataAddr)^;
|
|
end;
|
|
end;
|
|
|
|
function GetCounterValue64(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition=nil): UInt64;
|
|
var
|
|
DataAddr: Pointer;
|
|
begin
|
|
Result:=0;
|
|
|
|
DataAddr:=GetCounterDataAddress(AObj, ACounter, AInstance);
|
|
if not Assigned(DataAddr) then
|
|
Exit;
|
|
|
|
if ACounter^.CounterType and $00000300=PERF_SIZE_LARGE then // 64-bit value
|
|
case ACounter^.CounterType and $00000C00 of // counter type
|
|
PERF_TYPE_NUMBER, PERF_TYPE_COUNTER:
|
|
Result:=Uint64(PInt64(DataAddr)^);
|
|
end;
|
|
end;
|
|
|
|
function GetCounterValueText(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition=nil): PChar;
|
|
var
|
|
DataAddr: Pointer;
|
|
begin
|
|
Result:=nil;
|
|
|
|
DataAddr:=GetCounterDataAddress(AObj, ACounter, AInstance);
|
|
if not Assigned(DataAddr) then
|
|
Exit;
|
|
|
|
if ACounter^.CounterType and $00000300=PERF_SIZE_VARIABLE_LEN then // variable-length value
|
|
if (ACounter^.CounterType and $00000C00=PERF_TYPE_TEXT) and
|
|
(ACounter^.CounterType and $00010000=PERF_TEXT_ASCII) then
|
|
Result:=PChar(DataAddr);
|
|
end;
|
|
|
|
function GetCounterValueWideText(AObj: PPerfObjectType; ACounter: PPerfCounterDefinition;
|
|
AInstance: PPerfInstanceDefinition=nil): PWideChar;
|
|
var
|
|
DataAddr: Pointer;
|
|
begin
|
|
Result:=nil;
|
|
|
|
DataAddr:=GetCounterDataAddress(AObj, ACounter, AInstance);
|
|
if not Assigned(DataAddr) then
|
|
Exit;
|
|
|
|
if ACounter^.CounterType and $00000300=PERF_SIZE_VARIABLE_LEN then // variable-length value
|
|
if (ACounter^.CounterType and $00000C00=PERF_TYPE_TEXT) and
|
|
(ACounter^.CounterType and $00010000=PERF_TEXT_UNICODE) then
|
|
Result:=PWideChar(DataAddr);
|
|
end;
|
|
|
|
function GetFirstCounter(AObj: PPerfObjectType): PPerfCounterDefinition;
|
|
begin
|
|
if Assigned(AObj) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AObj)+AObj^.HeaderLength
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetFirstInstance(AObj: PPerfObjectType): PPerfInstanceDefinition;
|
|
begin
|
|
if not Assigned(AObj) or (AObj^.NumInstances=PERF_NO_INSTANCES) then
|
|
Result:=nil
|
|
else
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AObj)+SizeOf(TPerfObjectType)+(AObj^.NumCounters * SizeOf(TPerfCounterDefinition));
|
|
end;
|
|
|
|
function GetFirstObject(AData: PPerfDataBlock): PPerfObjectType; overload;
|
|
begin
|
|
if Assigned(AData) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AData)+AData^.HeaderLength
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetFirstObject(AHeader: PPerfLibHeader): PPerfObjectType; overload;
|
|
begin
|
|
if Assigned(AHeader) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AHeader)+SizeOf(TPerfLibHeader)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetInstance(AObj: PPerfObjectType; AIndex: Integer): PPerfInstanceDefinition;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Assigned(AObj) and (AIndex>=0) and (AIndex<=AObj^.NumInstances-1) then
|
|
begin
|
|
Result:=GetFirstInstance(AObj);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
|
|
for I:=0 to AIndex-1 do
|
|
begin
|
|
Result:=GetNextInstance(Result);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetInstanceName(AInstance: PPerfInstanceDefinition): PWideChar;
|
|
begin
|
|
if Assigned(AInstance) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AInstance)+AInstance^.NameOffset
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetNextCounter(ACounter: PPerfCounterDefinition): PPerfCounterDefinition;
|
|
begin
|
|
if Assigned(ACounter) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(ACounter)+ACounter^.ByteLength
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetNextInstance(AInstance: PPerfInstanceDefinition): PPerfInstanceDefinition;
|
|
var
|
|
Block: PPerfCounterBlock;
|
|
begin
|
|
Block:=GetCounterBlock(AInstance);
|
|
if Assigned(Block) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Block)+Block^.ByteLength
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetNextObject(AObj: PPerfObjectType): PPerfObjectType;
|
|
begin
|
|
if Assigned(AObj) then
|
|
{$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(Result):={$IFDEF WIN64}NativeUInt{$ELSE}Cardinal{$ENDIF}(AObj)+AObj^.TotalByteLength
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetObjectSize(AObj: PPerfObjectType): Cardinal;
|
|
var
|
|
I: Integer;
|
|
Instance: PPerfInstanceDefinition;
|
|
begin
|
|
Result:=0;
|
|
|
|
if Assigned(AObj) then
|
|
begin
|
|
if AObj^.NumInstances=PERF_NO_INSTANCES then
|
|
Result:=AObj^.TotalByteLength
|
|
else
|
|
begin
|
|
Instance:=GetFirstInstance(AObj);
|
|
if not Assigned(Instance) then
|
|
Exit;
|
|
|
|
for I:=0 to AObj^.NumInstances-1 do
|
|
begin
|
|
Instance:=GetNextInstance(Instance);
|
|
if not Assigned(Instance) then
|
|
Exit;
|
|
end;
|
|
|
|
Result:=Cardinal(Instance)-Cardinal(AObj);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetObject(AData: PPerfDataBlock; AIndex: Integer): PPerfObjectType;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Assigned(AData) and (AIndex>=0) and (Cardinal(AIndex)<=AData^.NumObjectTypes-1) then
|
|
begin
|
|
Result:=GetFirstObject(AData);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
|
|
for I:=0 to AIndex-1 do
|
|
begin
|
|
Result:=GetNextObject(Result);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetObject(AHeader: PPerfLibHeader; AIndex: Integer): PPerfObjectType;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Assigned(AHeader) and (AIndex>=0) then begin
|
|
Result:=GetFirstObject(AHeader);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
|
|
for I:=0 to AIndex-1 do begin
|
|
Result:=GetNextObject(Result);
|
|
if not Assigned(Result) then
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function GetObjectByNameIndex(AData: PPerfDataBlock; ANameIndex: Cardinal): PPerfObjectType;
|
|
var
|
|
AObj: PPerfObjectType;
|
|
I: Integer;
|
|
begin
|
|
Result:=nil;
|
|
|
|
AObj:=GetFirstObject(AData);
|
|
for I:=0 to AData^.NumObjectTypes-1 do begin
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
if AObj^.ObjectNameTitleIndex=ANameIndex then begin
|
|
Result:=AObj;
|
|
Break;
|
|
end;
|
|
|
|
AObj:=GetNextObject(AObj);
|
|
end;
|
|
end;
|
|
|
|
function GetObjectByNameIndex(AHeader: PPerfLibHeader; ANameIndex: Cardinal): PPerfObjectType; overload;
|
|
var
|
|
AObj: PPerfObjectType;
|
|
I: Integer;
|
|
begin
|
|
Result:=nil;
|
|
|
|
AObj:=GetFirstObject(AHeader);
|
|
for I:=0 to AHeader^.ObjectCount-1 do begin
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
if AObj^.ObjectNameTitleIndex=ANameIndex then begin
|
|
Result:=AObj;
|
|
Break;
|
|
end;
|
|
|
|
AObj:=GetNextObject(AObj);
|
|
end;
|
|
end;
|
|
|
|
function GetPerformanceData(const ARegValue: string): PPerfDataBlock;
|
|
const
|
|
BufSizeInc = 4096;
|
|
var
|
|
BufSize, RetVal: Cardinal;
|
|
begin
|
|
BufSize:=BufSizeInc;
|
|
Result:=AllocMem(BufSize);
|
|
try
|
|
RetVal:=RegQueryValueEx(HKEY_PERFORMANCE_DATA, PChar(ARegValue), 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(ARegValue), 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(AObj: PPerfObjectType; AProcessID: Cardinal): PPerfInstanceDefinition;
|
|
var
|
|
Counter: PPerfCounterDefinition;
|
|
Instance: PPerfInstanceDefinition;
|
|
Block: PPerfCounterBlock;
|
|
I: Integer;
|
|
begin
|
|
Result:=nil;
|
|
|
|
Counter:=GetCounterByNameIndex(AObj, CtrIDProcess);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
Instance:=GetFirstInstance(AObj);
|
|
for I:=0 to AObj^.NumInstances-1 do begin
|
|
Block:=GetCounterBlock(Instance);
|
|
if not Assigned(Block) then
|
|
Exit;
|
|
|
|
if PCardinal(Cardinal(Block)+Counter^.CounterOffset)^=AProcessID then begin
|
|
Result:=Instance;
|
|
Break;
|
|
end;
|
|
|
|
Instance:=GetNextInstance(Instance);
|
|
end;
|
|
end;
|
|
|
|
function GetSimpleCounterValue32(AObjIndex, ACtrIndex: Integer): Cardinal;
|
|
var
|
|
Data: PPerfDataBlock;
|
|
AObj: PPerfObjectType;
|
|
Counter: PPerfCounterDefinition;
|
|
begin
|
|
Result:=0;
|
|
|
|
Data:=GetPerformanceData(IntToStr(AObjIndex));
|
|
try
|
|
AObj:=GetObjectByNameIndex(Data, AObjIndex);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Counter:=GetCounterByNameIndex(AObj, ACtrIndex);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
Result:=GetCounterValue32(AObj, Counter);
|
|
finally
|
|
FreeMem(Data);
|
|
end;
|
|
end;
|
|
|
|
function GetSimpleCounterValue64(AObjIndex, ACtrIndex: Integer): UInt64;
|
|
var
|
|
Data: PPerfDataBlock;
|
|
AObj: PPerfObjectType;
|
|
Counter: PPerfCounterDefinition;
|
|
begin
|
|
Result:=0;
|
|
|
|
Data:=GetPerformanceData(IntToStr(AObjIndex));
|
|
try
|
|
AObj:=GetObjectByNameIndex(Data, AObjIndex);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Counter:=GetCounterByNameIndex(AObj, ACtrIndex);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
Result:=GetCounterValue64(AObj, Counter);
|
|
finally
|
|
FreeMem(Data);
|
|
end;
|
|
end;
|
|
|
|
function GetProcessName(AProcessID: Cardinal): WideString;
|
|
var
|
|
Data: PPerfDataBlock;
|
|
AObj: PPerfObjectType;
|
|
Instance: PPerfInstanceDefinition;
|
|
begin
|
|
Result:='';
|
|
|
|
Data:=GetPerformanceData(IntToStr(ObjProcess));
|
|
try
|
|
AObj:=GetObjectByNameIndex(Data, ObjProcess);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Instance:=GetProcessInstance(AObj, AProcessID);
|
|
if not Assigned(Instance) then
|
|
Exit;
|
|
|
|
Result:=GetInstanceName(Instance);
|
|
finally
|
|
FreeMem(Data);
|
|
end;
|
|
end;
|
|
|
|
function GetProcessPercentProcessorTime(AProcessID: Cardinal; AData1, AData2: PPerfDataBlock;
|
|
AProcessorCount: Integer): Double;
|
|
var
|
|
Value1, Value2: UInt64;
|
|
|
|
function GetValue(Data: PPerfDataBlock): UInt64;
|
|
var
|
|
AObj: PPerfObjectType;
|
|
Instance: PPerfInstanceDefinition;
|
|
Counter: PPerfCounterDefinition;
|
|
begin
|
|
Result:=0;
|
|
|
|
AObj:=GetObjectByNameIndex(Data, ObjProcess);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
Counter:=GetCounterByNameIndex(AObj, CtrPercentProcessorTime);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
Instance:=GetProcessInstance(AObj, AProcessID);
|
|
if not Assigned(Instance) then
|
|
Exit;
|
|
|
|
Result:=GetCounterValue64(AObj, Counter, Instance);
|
|
end;
|
|
begin
|
|
if AProcessorCount=-1 then
|
|
AProcessorCount:=GetProcessorCount;
|
|
|
|
Value1:=GetValue(AData1);
|
|
Value2:=GetValue(AData2);
|
|
|
|
Result:=100*(Value2-Value1)/(AData2^.PerfTime100nSec.QuadPart-AData1^.PerfTime100nSec.QuadPart)/AProcessorCount;
|
|
end;
|
|
|
|
function GetProcessPrivateBytes(AProcessID: Cardinal): UInt64;
|
|
var
|
|
Data: PPerfDataBlock;
|
|
AObj: PPerfObjectType;
|
|
Instance: PPerfInstanceDefinition;
|
|
Counter: PPerfCounterDefinition;
|
|
begin
|
|
Result:=0;
|
|
|
|
Data:=GetPerformanceData(IntToStr(ObjProcess));
|
|
try
|
|
AObj:=GetObjectByNameIndex(Data, ObjProcess);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Counter:=GetCounterByNameIndex(AObj, CtrPrivateBytes);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
Instance:=GetProcessInstance(AObj, AProcessID);
|
|
if not Assigned(Instance) then
|
|
Exit;
|
|
|
|
Result:=GetCounterValue64(AObj, Counter, Instance);
|
|
finally
|
|
FreeMem(Data);
|
|
end;
|
|
end;
|
|
|
|
function GetProcessThreadCount(AProcessID: Cardinal): Cardinal;
|
|
var
|
|
Data: PPerfDataBlock;
|
|
AObj: PPerfObjectType;
|
|
Instance: PPerfInstanceDefinition;
|
|
Counter: PPerfCounterDefinition;
|
|
begin
|
|
Result:=0;
|
|
|
|
Data:=GetPerformanceData(IntToStr(ObjProcess));
|
|
try
|
|
AObj:=GetObjectByNameIndex(Data, ObjProcess);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Counter:=GetCounterByNameIndex(AObj, CtrThreadCount);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
Instance:=GetProcessInstance(AObj, AProcessID);
|
|
if not Assigned(Instance) then
|
|
Exit;
|
|
|
|
Result:=GetCounterValue32(AObj, Counter, Instance);
|
|
finally
|
|
FreeMem(Data);
|
|
end;
|
|
end;
|
|
|
|
function GetProcessVirtualBytes(AProcessID: Cardinal): UInt64;
|
|
var
|
|
Data: PPerfDataBlock;
|
|
AObj: PPerfObjectType;
|
|
Instance: PPerfInstanceDefinition;
|
|
Counter: PPerfCounterDefinition;
|
|
begin
|
|
Result:=0;
|
|
|
|
Data:=GetPerformanceData(IntToStr(ObjProcess));
|
|
try
|
|
AObj:=GetObjectByNameIndex(Data, ObjProcess);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Counter:=GetCounterByNameIndex(AObj, CtrVirtualBytes);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
Instance:=GetProcessInstance(AObj, AProcessID);
|
|
if not Assigned(Instance) then
|
|
Exit;
|
|
|
|
Result:=GetCounterValue64(AObj, Counter, Instance);
|
|
finally
|
|
FreeMem(Data);
|
|
end;
|
|
end;
|
|
|
|
function GetProcessorCount: Integer;
|
|
var
|
|
Data: PPerfDataBlock;
|
|
AObj: PPerfObjectType;
|
|
begin
|
|
Result:=-1;
|
|
|
|
Data:=GetPerformanceData(IntToStr(ObjProcessor));
|
|
try
|
|
AObj:=GetFirstObject(Data);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Result:=AObj^.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;
|
|
AObj: PPerfObjectType;
|
|
Counter: PPerfCounterDefinition;
|
|
SecsStartup: UInt64;
|
|
begin
|
|
Result:=0;
|
|
|
|
Data:=GetPerformanceData(IntToStr(ObjSystem));
|
|
try
|
|
AObj:=GetObjectByNameIndex(Data, ObjSystem);
|
|
if not Assigned(AObj) then
|
|
Exit;
|
|
|
|
Counter:=GetCounterByNameIndex(AObj, CtrSystemUpTime);
|
|
if not Assigned(Counter) then
|
|
Exit;
|
|
|
|
SecsStartup:=GetCounterValue64(AObj, Counter);
|
|
// subtract from snapshot time and divide by base frequency and number of seconds per day
|
|
// to get a TDateTime representation
|
|
Result:=(UInt64(AObj^.PerfTime.QuadPart)-SecsStartup)/Uint64(AObj^.PerfFreq.QuadPart)/SecsPerDay;
|
|
finally
|
|
FreeMem(Data);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
QueryPerformanceFrequency(PerfFrequency);
|
|
|
|
finalization
|
|
|
|
end.
|