Evo jedne fje koja prikuplja podatke o procesima:
Code:
// Puni TProcessInfo strukturu listom aktivnih procesa
function EnumerateProcesses : TProcessInfo;
type
PPROCESS_MEMORY_COUNTER = ^_PROCESS_MEMORY_COUNTERS;
_PROCESS_MEMORY_COUNTERS = packed record
cb : LongWord;
PageFaultCount : LongWord;
PeakWorkingSetSize : LongWord;
WorkingSetSize : LongWord;
QuotaPeakPagedPoolUsage : LongWord;
QuotaPagedPoolUsage : LongWord;
QuotaPeakNonPagedPoolUsage : LongWord;
QuotaNonPagedPoolUsage : LongWord;
PagefileUsage : LongWord;
PeakPagefileUsage : LongWord;
end;
PTOKEN_USER = ^_TOKEN_USER;
_TOKEN_USER = record
User : TSidAndAttributes;
end;
TProcessEntry32 = packed record
dwSize : LongWord;
cntUsage : LongWord;
th32ProcessID : LongWord;
th32DefaultHeapID : LongWord;
th32ModuleID : LongWord;
cntThreads : LongWord;
th32ParentProcessID : LongWord;
pcPriClassBase : Longint;
dwFlags : LongWord;
szExeFile : Array[0..MAX_PATH - 1] of Char;
end;
var
EnumProcessModules : function(hProcess : THandle;
lphModule : PLongWord;
cb : LongWord;
var lpcbNeeded : LongWord) : Boolean; stdcall;
GetModuleFileNameEx : function(hProcess : THandle;
hModule : HMODULE;
lpFilename : PAnsiChar;
nSize : LongWord) : LongWord; stdcall;
GetProcessMemoryInfo : function(Process : THandle;
ppsmemCounters : PPROCESS_MEMORY_COUNTER;
cb : LongWord) : Boolean; stdcall;
function GetUserAndDomain(PID : LongWord; var User, Domain : String) : Boolean;
var
hToken : THandle;
cbBuf : Cardinal;
ptiUser : PTOKEN_USER;
snu : LongWord;
ProcessHandle : THandle;
UserSize,
DomainSize : LongWord;
bSuccess : Boolean;
begin
result := FALSE;
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, PID);
If ProcessHandle <> 0 Then
Begin
If OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) Then
Begin
bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
ptiUser := nil;
while (not bSuccess) and
(GetLastError = ERROR_INSUFFICIENT_BUFFER) Do
Begin
ReallocMem(ptiUser, cbBuf);
bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
End;
CloseHandle(hToken);
If not bSuccess Then
Exit;
UserSize := 0;
DomainSize := 0;
LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);
If (UserSize <> 0) and
(DomainSize <> 0) Then
Begin
SetLength(User, UserSize);
SetLength(Domain, DomainSize);
If LookupAccountSid(nil,
ptiUser.User.Sid,
PAnsiChar(User),
UserSize,
PAnsiChar(Domain),
DomainSize,
snu) Then
Begin
result := TRUE;
User := PAnsiChar(User);
Domain := PAnsiChar(Domain);
End;
End;
If bSuccess then
FreeMem(ptiUser);
End;
CloseHandle(ProcessHandle);
End;
end;
function GetProcessPath(const PID : LongWord) : String;
var
C1 : Integer;
cbNeeded : LongWord;
modules : Array[1..1024] of hInst;
ProcHandle : THandle;
filename : Array[0..512] of Char;
begin
SetLastError(0);
result := '';
ProcHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PID);
If ProcHandle <> 0 Then
Begin
If EnumProcessModules(ProcHandle, @modules[1], SizeOf(modules), cbNeeded) Then
For C1 := 1 to cbNeeded div SizeOf(hInst) Do
If GetModuleFilenameEx(ProcHandle, modules[C1], filename, SizeOf(filename)) > 0 Then
Begin
result := filename;
break;
End;
CloseHandle(ProcHandle);
End;
end;
procedure AddProcess(const exefile : String; const PID : Integer);
var
pmc : PPROCESS_MEMORY_COUNTER;
cb : Integer;
phnd : THandle;
begin
Inc(result.TotalProcesses);
SetLength(result.ProcessName, result.TotalProcesses);
SetLength(result.ProcessPID, result.TotalProcesses);
SetLength(result.ProcessPath, result.TotalProcesses);
SetLength(result.ProcessUser, result.TotalProcesses);
SetLength(result.ProcessDomain, result.TotalProcesses);
SetLength(result.UsedMemory, result.TotalProcesses);
result.ProcessName[result.TotalProcesses - 1] := exefile;
result.ProcessPID[result.TotalProcesses - 1] := PID;
result.ProcessPath[result.TotalProcesses - 1] := GetProcessPath(PID);
GetUserAndDomain(PID, result.ProcessUser[result.TotalProcesses - 1], result.ProcessDomain[result.TotalProcesses - 1]);
cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
GetMem(pmc, cb);
pmc^.cb := cb;
phnd := OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, PID);
If GetProcessMemoryInfo(phnd, pmc, cb) Then
result.UsedMemory[result.TotalProcesses - 1] := Round(pmc^.WorkingSetSize / 1024);
CloseHandle(phnd);
FreeMem(pmc);
end;
var
Process32First,
Process32Next : function(hSnapshot : THandle; var lppe : TProcessEntry32) : Boolean; stdcall;
CreateToolhelp32Snapshot : function(dwFlags, th32ProcessID : LongWord) : THandle; stdcall;
handler : THandle;
data : TProcessEntry32;
kernel32 : THandle;
hPsAPI : THandle;
begin
kernel32 := GetModuleHandle('kernel32');
@CreateToolhelp32Snapshot := GetProcAddress(kernel32, 'CreateToolhelp32Snapshot');
@Process32First := GetProcAddress(kernel32, 'Process32First');
@Process32Next := GetProcAddress(kernel32, 'Process32Next');
hPsAPI := LoadLibrary('PsAPI');
@EnumProcessModules := GetProcAddress(hPsAPI, 'EnumProcessModules');
@GetModuleFileNameEx := GetProcAddress(hPsAPI, 'GetModuleFileNameExA');
@GetProcessMemoryInfo := GetProcAddress(hPSAPI, 'GetProcessMemoryInfo');
result.TotalProcesses := 0;
SetLength(result.ProcessName, 0);
SetLength(result.ProcessPID, 0);
handler := CreateToolhelp32Snapshot($F, 0);
data.dwSize := SizeOf(data);
If Process32First(handler, data) Then
Begin
AddProcess(data.szExeFile, data.th32ProcessID);
While Process32Next(handler, data) Do
AddProcess(data.szExeFile, data.th32ProcessID);
End;
CloseHandle(handler);
FreeLibrary(hPsAPI);
end;
A TProcessInfo struktura izgleda ovako:
Code:
TProcessInfo = record // Informacije o procesima
TotalProcesses : Cardinal; // Broj procesa
ProcessName : Array of String; // Ime procesa
ProcessPID : Array of Cardinal; // PID procesa
ProcessPath : Array of String; // Putanja binary-a procesa
ProcessUser : Array of String; // User pod kojim se proces izvrsaca
ProcessDomain : Array of String; // Domain pod kojim se proces izvrsava
UsedMemory : Array of Cardinal; // Kolicina memorije koju proces zauzima (Kb)
end;
[Ovu poruku je menjao reiser dana 28.06.2005. u 20:09 GMT+1]
[Ovu poruku je menjao reiser dana 28.06.2005. u 20:13 GMT+1]