Получить список процессов в компьютере сети
Материал из DRKB
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;
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;
end;
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;
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;
end.
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03308