Получить список процессов в компьютере сети

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
Category:Связь