unit ProcessManager;
{-----------------------------------------------------------------------------
Filename : ProcessManager.pas
Project :
Date : 2007-01-26
Author : Benjamin Loschke
Contents : Gathers process information and allows to
kill them.
License- : You're allowed to use this source for your own good at will,
Information but you have to leave some hint in your source code,
that this code is from me. I can't control it, but its
just fair, I think. :)
Der Source-Code darf frei nach gutdüngten von jedermann genutzt
werden. Einzigste Bedingung, hinterlaßt hinweise in euerm Code
aus dennen ersichtlich ist, dass der Code von mir stammt. Ich
kann im einzelnen das nicht kontrollieren, aber meiner Meinung nach
ist es nur fair, denke ich. :)
-----------------------------------------------------------------------------}
interface
uses Windows, psapi, ExtCtrls, tlhelp32;
//Struktur in der die Filetimes eines Prozesses
//gespeichert werden.
type
TCPULOAD =
Record
PID: Integer;
Exename:
String;
dwOldTime,dwNewTime: Cardinal;
lOldUser,lNewUser: Cardinal;
lOldKernel, lNewKernel: Cardinal;
Show: Integer;
end;
//Array in dem die Filetimes der einzelnen Prozesse
//gespeichert werden.
TCPULOADS =
Array of TCPULOAD;
type
TProcessManager =
class(TObject)
private
tRefresher: TTimer;
processes: TCPULoads;
RI: Integer;
Function GetTime(fFiletime: FileTime): Cardinal;
Procedure RefreshSnapShot;
Procedure RefreshProcesslist(Sender: TObject);
Procedure SetRefreshInterval(newInterval: Integer);
public
constructor create(RI: Integer);
destructor Free;
Function GetCPUTimeforProcess(PID: Integer): Integer;
Function GetMemoryUsageforProcess(PID: Integer):Cardinal;
Function KillProcess(PID: Integer): Boolean;
Function GetProcesses: TCPULoads;
Property RefreshInterval: Integer
read RI
write SetRefreshInterval;
end;
implementation
constructor TProcessManager.create(RI: Integer);
begin
tRefresher:=TTimer.Create(
nil);
RefreshInterval:=RI;
tRefresher.Interval:=RefreshInterval;
tRefresher.OnTimer:=RefreshProcesslist;
RefreshProcesslist(self);
tRefresher.Enabled:=True;
end;
destructor TProcessManager.Free;
begin
tRefresher.Enabled:=false;
tRefresher.Free;
end;
Function TProcessManager.GetTime(fFileTime: FileTime): Cardinal;
//Diese Funktion gibt mir gibt den Sekunden- und Millisekundenteil
//der Filetimes in MILLISEKUNDEN wieder...
//wird für die Berechnung neuezeit-altezeit gebraucht.
var
sSystemTime: SystemTime;
begin
FileTimeToSystemTime(fFileTime,sSystemTime);
result := (sSystemTime.wSecond*1000)+sSystemTime.wMilliseconds;
end;
Function TProcessManager.GetCPUTimeforProcess(PID: Integer): Integer;
//Diese Funktion berechnet Prozessorauslastung eines Prozesses
var
lUser, lKernel: Cardinal;
I,idx: Integer;
dwTime: DWORD;
begin
Result:=0;
idx:=-1;
for i:=0
to length(processes)-1
do
if(processes[i].PID=PID)
then begin
idx:=i;
break;
end;
if(idx>-1)
then begin
lKernel := processes[idx].lNewKernel - processes[idx].lOldKernel;
lUser := processes[idx].lNewUser - processes[idx].lOldUser;
dwTime := processes[idx].dwNewTime - processes[idx].dwOldTime;
//hier wird die Tatsächliche Prozessorauslastung gemessen, indem
//die Differenzen von Kernel und Userzeit addiert werden diese Addition wird
//multipliziert mit 100 und dann durch die Tickcount-Differenz geteilt.
//Rückgabe des Ergebnisses
if(dwTime>0)
then Result := ((lKernel+lUser)*100)
div (dwTime)
else Result:=0;
end;
end;
Function TProcessManager.KillProcess(PID: Integer): Boolean;
//Funktion, leicht modifiziert, kopiert von Michael Puff's Sysinfo
//war zu faul die selbst nachzuschlagen ;)
var
hProcess : Cardinal;
dw : DWORD;
begin
{ open the process and store the process-handle }
hProcess := OpenProcess(SYNCHRONIZE
or PROCESS_TERMINATE, False, PID);
{ kill it }
TerminateProcess(hProcess, 0);
{ TerminateProcess returns immediately, so wie have to verify the result via
WaitfForSingleObject }
dw := WaitForSingleObject(hProcess, 5000);
result:=true;
case dw
of
{ process could not be terminated after 5 seconds }
WAIT_TIMEOUT:
begin
Result:=false;
exit;
end;
{ error in calling WaitForSingleObject }
WAIT_FAILED:
begin
Result:=false;
exit;
end;
end;
end;
Function TProcessManager.GetMemoryUsageforProcess(PID: Integer): Cardinal;
//Funktion ermittelt Memory-Usage für einen einzelnen Prozess.
var
procmemcou: PPROCESS_MEMORY_COUNTERS;
i: Integer;
HLE: THandle;
begin
Result:=0;
i := SizeOf(_PROCESS_MEMORY_COUNTERS);
GetMem(procmemcou, i);
procmemcou^.cb := i;
HLE:=OpenProcess(PROCESS_QUERY_INFORMATION, false, PID);
if GetProcessMemoryInfo(HLE, procmemcou, i)
then
Result:=procmemcou^.WorkingSetSize
div 1024;
closehandle(hle);
FreeMem(procmemcou);
end;
Procedure TProcessManager.RefreshSnapShot;
//Diese Funktion ermittelt alle momentan laufenden Prozesse
//und speichert Werte von diesen in dem eindimensionalen
//Array "progs"
var
hSnap : THandle;
pe32 : TProcessEntry32;
i: integer;
temp: TCPULOADS;
begin
tRefresher.Enabled:=false;
//initiallisieren von Variablen
i:=-1;
ZeroMemory(@pe32, sizeof(pe32));
pe32.dwSize := sizeof(TProcessEntry32);
//Erstellt eine Momentaufnahme der Prozessumgebung (heap, threads, processes and so on)
hSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
//wenn erster Durchlauf erfolgreich, dann...
if Process32First(hSnap, pe32) = TRUE
then begin
//solange ein Prozess gefunden wird
while Process32Next(hSnap, pe32) = TRUE
do begin
//schreibe die Prozess-ID und den Anwendungsnamen in das eindimensionale Array "PROGS"
inc(i);
SetLength(temp,i+1);
temp[i].PID:=pe32.th32ProcessID;
temp[i].Exename:=pe32.szExeFile;
end;
end;
setlength(processes,i+1);
//übertrage altdaten von progs-array auf das temp-array
for i:=0
to length(temp)-1
do
if(temp[i].PID=processes[i].PID)
then temp[i]:=processes[i];
//überschreibe progs mit dem temp-array, notwendig damit neue
//Prozesse überwacht werden und geschlossene rausgeschmiessen werden.
processes:=temp;
//Starte Timer
tRefresher.Enabled:=true;
end;
Procedure TProcessManager.RefreshProcesslist(Sender: TObject);
//Bei jedem Interval des Timers werden die Werte neu ermittelt
var
i : Integer;
HLE : THandle;
ftCreate, ftExit, ftUser, ftKernel: FileTime;
begin
//refreshe die Momentaufnahme der aktuellen Prozesse
RefreshSnapShot;
//durchlaufe alle datensaetze des eindimensionalen arrays "Progs"
for i:=0
to length(processes)-1
do begin
Zeromemory(@ftuser,sizeof(ftuser));
Zeromemory(@ftuser,sizeof(ftkernel));
//vertausche alte mit neuen Werten
processes[i].dwOldTime :=processes[i].dwnewTime;
processes[i].lOldUser :=processes[i].lNewUser;
processes[i].lOldKernel :=processes[i].lNewKernel;
//Process zum Informationen lesen öffnen
HLE:=OpenProcess(PROCESS_QUERY_INFORMATION, false, processes[i].PID);
//Wenn das Fenster der Unit bewegt wird, funktioniert die Openprocess-
//Funktion nicht mehr richtig und gibt ein Handle=0 zurück.
//Also Nur Neue Werte zuweisen, wenn HLE <> 0
if(HLE<>0)
then begin
//Ermittele Erstellungszeit, ..., Kernelzeit und Userzeit des Prozesses
GetProcessTimes(HLE, ftCreate, ftExit, ftKernel, ftUser);
//Ermittele neuen Tickcount
processes[i].dwNewTime := GetTickCount;
//Setze die neue User- und Kerneltime ins array
processes[i].lNewUser := GetTime( ftUser );
processes[i].lNewKernel := GetTime( ftKernel );
end;
//Schliesse Prozesshandle
CloseHandle(HLE);
end;
end;
Function TProcessManager.GetProcesses: TCPULoads;
begin
Result:=Processes;
end;
Procedure TProcessManager.SetRefreshInterval(newInterval: Integer);
begin
RI:=newInterval;
tRefresher.Interval:=RI;
end;
end.