unit Unit1;
{
Author: Benjamin Loschke
Date: 24.01.2007
Zweck: Dieses Programm ermittelt die momentan auf dem System
laufenden Prozesse und ermittelt die Cpu-Auslastung
eines jeden Prozesses. Es zeigt nur die Prozesse an
die eine Auslastung von über 0% besitzen oder es vor
bis zu 10 Refreshzyklen hatten.
Update: 25.01.2007
Programm unterstützt nun das ausfiltern von gewissen Programmen.
ListBox wird jetzt als MulticolumnListbox angezeigt.
Trackbar eingebettet, mit dem man die Refreshzeiten einstellen kann.
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, tlhelp32,processinfo, ExtCtrls, ComCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
ListBox1: TListBox;
Timer1: TTimer;
TrackBar1: TTrackBar;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
private
public
end;
//Struktur in der die Filetimes eines Prozesses
//gespeichert werden.
TCPULOAD =
Record
PID: Cardinal;
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;
var
Form1: TForm1;
implementation
var
Progs: TCPULOADS;
ftCreate, ftExit, ftUser, ftKernel: FileTime;
{$R *.dfm}
function GetTime(ftTime: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
stTime: SystemTime;
iTime: cardinal;
begin
FileTimeToSystemTime(ftTime,stTime);
iTime := (stTime.wSecond*1000)+stTime.wMilliseconds;
result := iTime;
end;
Function GetCpuProcUsage(lnewkernel,loldkernel,lnewuser,lolduser,dwNewTime,dwOldTime:cardinal): Cardinal;
//Diese Funktion berechnet aufgrund der diversen neu und altwerte die Prozessorauslastung eines
//Prozesses
var
lUser, lKernel: Cardinal;
dwTime: DWORD;
begin
//hier wird die Differenz zwischen alter und neuer Kernelzeit ermittelt
lKernel := lNewKernel - lOldKernel;
//hier wird die Differenz zwischen alter und neuer Userzeit ermittelt
lUser := lNewUser - lOldUser;
//hier wird die Differenz zwischen dem alte und dem neuen Tickcount ermittelt
//Erklärung siehe Hilfe zu GetTickCount(); [1 Tick ==> 1 Millisekunde]
dwTime := dwNewTime - dwOldTime;
//Gebe der Anwendung Zeit sich neu aufzubauen, hilfreich, wenn diese Funktion oft
//hintereinander aufgerufen wird.
Application.ProcessMessages;
//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
Result := ((lKernel+lUser)*100)
div (dwTime);
end;
procedure TForm1.Button1Click(Sender: TObject);
//Diese Funktion ermittelt alle momentan laufenden Prozesse
//und speichert Werte von diesen in dem eindimensionalen
//Array "progs"
var
hSnap : THandle;
pe32 : TProcessEntry32;
i: integer;
begin
//initiallisieren von Variablen
i:=-1;
SetLength(progs,0);
ListBox1.Clear;
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(progs,i+1);
progs[i].PID:=pe32.th32ProcessID;
progs[i].Exename:=pe32.szExeFile;
end;
end;
//Starte Timer
Timer1.Enabled:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
//Bei jedem Interval des Timers werden die Werte neu ermittelt
var
i : Integer;
HLE : THandle;
begin
//durchlaufe alle datensaetze des eindimensionalen arrays "Progs"
for i:=0
to length(progs)-1
do begin
Zeromemory(@ftuser,sizeof(ftuser));
Zeromemory(@ftuser,sizeof(ftkernel));
//vertausche alte mit neuen Werten
progs[i].dwOldTime :=progs[i].dwnewTime;
progs[i].lOldUser :=progs[i].lNewUser;
progs[i].lOldKernel :=progs[i].lNewKernel;
//Ermittele neuen Tickcount
progs[i].dwNewTime := GetTickCount;
//Process zum Informationen lesen öffnen
HLE:=OpenProcess(PROCESS_QUERY_INFORMATION, false, progs[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);
//Setze die neue User- und Kerneltime ins array
progs[i].lNewUser := GetTime( ftUser );
progs[i].lNewKernel := GetTime( ftKernel );
end;
//Schliesse Prozesshandle
CloseHandle(HLE);
end;
//refreshe die Listbox
button2Click(self);
end;
procedure TForm1.Button2Click(Sender: TObject);
//Diese Funktion füllt die Listbox mit den Prozessen
//die eine CPUTime von über 0 haben oder eine
//hatten vor unter 10 Refreshzyklen
var i,e: integer;
CPULAST: Integer;
begin
//Einträge aus der Listbox löschen
listbox1.Clear;
//initialisieren von e
e:=0;
//Schleife über jeden Prozess der in der Schleife gespeichert ist...
for i:=1
to length(progs)-1
do
begin
CPUlast:=GetCpuProcUsage(progs[i].lnewkernel,progs[i].loldkernel,progs[i].lnewuser,progs[i].lolduser,progs[i].dwNewTime,progs[i].dwOldTime);
//zähle die CPUUsage der einzelnen Prozesse zusammen...
inc(e,CPULAST);
//Wenn ein Prozess mehr als 0% CPUTime benutzt, füge ihn in die Listbox ein
//und falls der Filter gesetzt ist, der Filter mit dem Eintrag übereinstimmt
if((CPULast>0))
then
begin
//Zeige den Prozess auch noch 10mal an, wenn die CPUTime wieder auf 0 sinkt
//verbessert die Lesbarkeit!!
progs[i].Show:=10;
Listbox1.Items.Add(progs[i].Exename+^I+inttostr(CPULAST)+'
%');
end;
//wenn die Showvariable über 0 ist und die CPUTime auf 0 oder unter null dann füge den Prozess ein.
if((progs[i].Show>0)
and (CPULAST<=0) )
then
begin
Listbox1.Items.Add(progs[i].Exename+^I+inttostr(CPULAST)+'
%');
//dezimiere die Showvariable
dec(progs[i].Show);
end;
end;
//ziehe von hundert die ermittelte summe der prozesscputimes ab und es ergibt die
//CPUTime des Lehrlaufprozesses
ListBox1.Items.Add('
Leerlaufprozess '+^I+IntToStr(100-e)+'
%');
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
//wenn die Trackbar bewegt wird, schreibe den neuen wert in das interval-
//property des timers
Timer1.Interval:=trackbar1.Position;
//gebe das neue Timer-Interval an das Label1 aus.
Label1.Caption:='
Refresh-Interval: '+IntTostr(trackbar1.Position)+'
ms';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//einmal das Trackbar1Change-Ereigniss aufrufen...
trackbar1change(self);
end;
end.