Delphi-PRAXiS - Delphi CPU auslastung der einzelnen Prozesse

Zitat:
Zitat von F.Art
Ich möchte in einer ListBox alle Prozesse mit der aktuellen CPU Auslastung haben.
Zu dem möchte ich durch den klick auf de ListBox den entsprechenden Prozess killen können.

Wer hat da was für mich?
Zu dieser Fragestellung habe ich gerade ein Programm entwickelt. Poste hier mal die Unit meines Programmes. Aufgrund des Quellcodes sollte es möglich sein, das Feature auch im eigenen Programm zu realisieren.
Delphi-Quellcode:
			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.
Falls noch Fragen offen bleiben schreibt ein Post oder meldet euch per ICQ (68525710) bei mir.

mfg
Benjamin Loschke