获取进程列表和系统性能计数器信息

Tags: /超级猛料/OS.操作系统/Process.进程/ Date Created:

获取进程列表和系统性能计数器信息

unit PerfInfo;

interface

uses

Windows, SysUtils, Classes;

type

TPerfCounter = record

Counter: Integer;

Value: TLargeInteger;

end;

TPerfCounters = Array of TPerfCounter;

TPerfInstance = class

private

FName: string;

FCounters: TPerfCounters;

public

property Name: string read FName;

property Counters: TPerfCounters read FCounters;

end;

TPerfObject = class

private

FList: TList;

FObjectID: DWORD;

FMachine: string;

function GetCount: Integer;

function GetInstance(Index: Integer): TPerfInstance;

procedure ReadInstances;

public

property ObjectID: DWORD read FObjectID;

property Item[Index: Integer]: TPerfInstance

read GetInstance; default;

property Count: Integer read GetCount;

constructor Create(const AMachine: string; AObjectID: DWORD);

destructor Destroy; override;

end;

procedure GetProcesses(const Machine: string; List: TStrings);

implementation

type

PPerfDataBlock = ^TPerfDataBlock;

TPerfDataBlock = record

Signature: array[0..3] of WCHAR;

LittleEndian: DWORD;

Version: DWORD;

Revision: DWORD;

TotalByteLength: DWORD;

HeaderLength: DWORD;

NumObjectTypes: DWORD;

DefaultObject: Longint;

SystemTime: TSystemTime;

PerfTime: TLargeInteger;

PerfFreq: TLargeInteger;

PerfTime100nSec: TLargeInteger;

SystemNameLength: DWORD;

SystemNameOffset: DWORD;

end;

PPerfObjectType = ^TPerfObjectType;

TPerfObjectType = record

TotalByteLength: DWORD;

DefinitionLength: DWORD;

HeaderLength: DWORD;

ObjectNameTitleIndex: DWORD;

ObjectNameTitle: LPWSTR;

ObjectHelpTitleIndex: DWORD;

ObjectHelpTitle: LPWSTR;

DetailLevel: DWORD;

NumCounters: DWORD;

DefaultCounter: Longint;

NumInstances: Longint;

CodePage: DWORD;

PerfTime: TLargeInteger;

PerfFreq: TLargeInteger;

end;

PPerfCounterDefinition = ^TPerfCounterDefinition;

TPerfCounterDefinition = record

ByteLength: DWORD;

CounterNameTitleIndex: DWORD;

CounterNameTitle: LPWSTR;

CounterHelpTitleIndex: DWORD;

CounterHelpTitle: LPWSTR;

DefaultScale: Longint;

DetailLevel: DWORD;

CounterType: DWORD;

CounterSize: DWORD;

CounterOffset: DWORD;

end;

PPerfInstanceDefinition = ^TPerfInstanceDefinition;

TPerfInstanceDefinition = record

ByteLength: DWORD;

ParentObjectTitleIndex: DWORD;

ParentObjectInstance: DWORD;

UniqueID: Longint;

NameOffset: DWORD;

NameLength: DWORD;

end;

PPerfCounterBlock = ^TPerfCounterBlock;

TPerfCounterBlock = record

ByteLength: DWORD;

end;

{Navigation helpers}

function FirstObject(PerfData: PPerfDataBlock): PPerfObjectType;

begin

Result := PPerfObjectType(DWORD(PerfData) + PerfData.HeaderLength);

end;

function NextObject(PerfObj: PPerfObjectType): PPerfObjectType;

begin

Result := PPerfObjectType(DWORD(PerfObj) + PerfObj.TotalByteLength);

end;

function FirstInstance(PerfObj: PPerfObjectType): PPerfInstanceDefinition;

begin

Result := PPerfInstanceDefinition(DWORD(PerfObj) + PerfObj.DefinitionLength);

end;

function NextInstance(PerfInst: PPerfInstanceDefinition): PPerfInstanceDefinition;

var

PerfCntrBlk: PPerfCounterBlock;

begin

PerfCntrBlk := PPerfCounterBlock(DWORD(PerfInst) + PerfInst.ByteLength);

Result := PPerfInstanceDefinition(DWORD(PerfCntrBlk) + PerfCntrBlk.ByteLength);

end;

function FirstCounter(PerfObj: PPerfObjectType): PPerfCounterDefinition;

begin

Result := PPerfCounterDefinition(DWORD(PerfObj) + PerfObj.HeaderLength);

end;

function NextCounter(PerfCntr: PPerfCounterDefinition): PPerfCounterDefinition;

begin

Result := PPerfCounterDefinition(DWORD(PerfCntr) + PerfCntr.ByteLength);

end;

{Registry helpers}

function GetPerformanceKey(const Machine: string): HKey;

var

s: string;

begin

Result := 0;

if Length(Machine) = 0 then

Result := HKEY_PERFORMANCE_DATA

else

begin

s := Machine;

if Pos('\\', s) <> 1 then

s := '\\' + s;

if RegConnectRegistry(PChar(s), HKEY_PERFORMANCE_DATA, Result) <> ERROR_SUCCESS then

Result := 0;

end;

{TPerfObject}

constructor TPerfObject.Create(const AMachine: string; AObjectID: DWORD);

begin

inherited Create;

FList := TList.Create;

FMachine := AMachine;

FObjectID := AObjectID;

ReadInstances;

end;

destructor TPerfObject.Destroy;

var

i: Integer;

begin

for i := 0 to FList.Count - 1 do

TPerfInstance(FList[i]).Free;

FList.Free;

inherited Destroy;

end;

function TPerfObject.GetCount: Integer;

begin

Result := FList.Count;

end;

function TPerfObject.GetInstance(Index: Integer): TPerfInstance;

begin

Result := FList[Index];

end;

procedure TPerfObject.ReadInstances;

var

PerfData: PPerfDataBlock;

PerfObj: PPerfObjectType;

PerfInst: PPerfInstanceDefinition;

PerfCntr, CurCntr: PPerfCounterDefinition;

PtrToCntr: PPerfCounterBlock;

BufferSize: Integer;

i, j, k: Integer;

pData: PLargeInteger;

Key: HKey;

CurInstance: TPerfInstance;

begin

for i := 0 to FList.Count - 1 do

TPerfInstance(FList[i]).Free;

FList.Clear;

Key := GetPerformanceKey(FMachine);

if Key = 0 then Exit;

PerfData := nil;

try

{Allocate initial buffer for object information}

BufferSize := 65536;

GetMem(PerfData, BufferSize);

{retrieve data}

while RegQueryValueEx(Key,

PChar(IntToStr(FObjectID)), {Object name}

nil, nil, Pointer(PerfData), @BufferSize) = ERROR_MORE_DATA do

begin

{buffer is too small}

Inc(BufferSize, 1024);

ReallocMem(PerfData, BufferSize);

end;

RegCloseKey(HKEY_PERFORMANCE_DATA);

{Get the first object type}

PerfObj := FirstObject(PerfData);

{Process all objects}

for i := 0 to PerfData.NumObjectTypes - 1 do

begin

{Check for requested object}

if PerfObj.ObjectNameTitleIndex = FObjectID then

begin

{Get the first counter}

PerfCntr := FirstCounter(PerfObj);

if PerfObj.NumInstances > 0 then

begin

{Get the first instance}

PerfInst := FirstInstance(PerfObj);

{Retrieve all instances}

for k := 0 to PerfObj.NumInstances - 1 do

begin

{Create entry for instance}

CurInstance := TPerfInstance.Create;

CurInstance.FName := WideCharToString(PWideChar(DWORD(PerfInst) +

PerfInst.NameOffset));

FList.Add(CurInstance);

CurCntr := PerfCntr;

{Retrieve all counters}

SetLength(CurInstance.FCounters, PerfObj.NumCounters);

for j := 0 to PerfObj.NumCounters - 1 do

begin

PtrToCntr := PPerfCounterBlock(DWORD(PerfInst) + PerfInst.ByteLength);

pData := Pointer(DWORD(PtrToCntr) + CurCntr.CounterOffset);

{Add counter to array}

CurInstance.FCounters[j].Counter := CurCntr.CounterNameTitleIndex;

CurInstance.FCounters[j].Value := pData^;

{Get the next counter}

CurCntr := NextCounter(CurCntr);

end;

{Get the next instance.}

PerfInst := NextInstance(PerfInst);

end;

{Get the next object type}

PerfObj := NextObject(PerfObj);

end;

finally

{Release buffer}

FreeMem(PerfData);

{Close remote registry handle}

if Key <> HKEY_PERFORMANCE_DATA then

RegCloseKey(Key);

end;

procedure GetProcesses(const Machine: string; List: TStrings);

var

Processes: TPerfObject;

i, j: Integer;

ProcessID: DWORD;

begin

Processes := nil;

List.Clear;

try

Processes := TPerfObject.Create(Machine, 230); {230 = Process}

for i := 0 to Processes.Count - 1 do

{Find process ID}

for j := 0 to Length(Processes[i].Counters) - 1 do

if (Processes[i].Counters[j].Counter = 784) then

begin

ProcessID := Processes[i].Counters[j].Value;

if ProcessID <> 0 then

List.AddObject(Processes[i].Name, Pointer(ProcessID));

Break;

end;

finally

Processes.Free;

end;

end.