Delphi-PRAXiS
Seite 1 von 2  1 2   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi CPU auslastung der einzelnen Prozesse (https://www.delphipraxis.net/35168-cpu-auslastung-der-einzelnen-prozesse.html)

F.Art 3. Dez 2004 14:01


CPU auslastung der einzelnen Prozesse
 
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?

Matze 3. Dez 2004 14:05

Re: CPU auslastung der einzelnen Prozesse
 
Code zum Auflisten und Beenden der Prozesse findest du in der Code-Library: [cl]prozess*[/cl]

F.Art 3. Dez 2004 15:49

Re: CPU auslastung der einzelnen Prozesse
 
Das auflisten und killen klappt nun.
Aber was nocht fehlt ist das er die CPU Auslastung hinter jedem Prozess bei schreibt.

supermuckl 3. Dez 2004 17:36

Re: CPU auslastung der einzelnen Prozesse
 
Stichwort Perfmon ( Performance Monitor )
Ist eine API Schnittstelle wo du auf die Counters von Windows zugreifen kannst. Darunter fallen auch alle Prozesse und ihre Messwerte/Statistiken an.

Entsprechende Perfmon Komponenten für Delphi gibt es. Habe selbst eine schon ausprobiert.

ElectricalFire 19. Jun 2005 20:00

Re: CPU auslastung der einzelnen Prozesse
 
Was sind denn das fuer perfmon mkompos, hab noch nie was von denen gehoert. kannst du mir sagen wo du die her hast?

Gruss, ElectricalFire

Olli 19. Jun 2005 22:01

Re: CPU auslastung der einzelnen Prozesse
 
Mit dem Source von PView2 kannst du im Übrigen sehen, wie es auch ohne "Kompos" lösbar ist ;)

Darkmorph 25. Jan 2007 15:59

Re: 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

Olli 25. Jan 2007 18:40

Re: CPU auslastung der einzelnen Prozesse
 
Jetzt waere es noch ideal, wenn du dazuschreiben wuerdest, unter welchen Lizenzbedingungen dein Code benutzt wird. Ansonsten, alles in allem gute Arbeit! :thumb: ... obwohl ich persoenlich die eigentlichen "Arbeitstiere" der Unit in eine Include-Datei oder separate Unit ausgelagert und hier gepostet haette ;)

Fragen, hmmm?! Woher kommt die Unit ProcessInfo, bzw. woher bekommt sie der Nutzer deines Codes?

Hinweis: "Application.ProcessMessages" solltest du moeglichst vermeiden, da es deinen Code unflexibel macht.

Lob: Gut auskommentiert. Ich muss sagen, dass mich das besonders begeistert, obwohl ich nicht weiss wie neu du bist. Aber Respekt. Wuerden alle ihren Code so kommentieren, waere Legacy-Code nie wieder ein Problem.

Darkmorph 25. Jan 2007 21:55

Re: CPU auslastung der einzelnen Prozesse
 
hi olli,

antworte morgen im detail, aber erstemal soviel. Hab gestern um 16:00h mit dem Programm angefangen -18:00h und heute noch bissl nebenher... War mehr oder weniger nur, um zu schauen ob ich die Nuss knacke ;)
Hab das Programm mittlerweile soweit, das es ein nützlicher Ersatz für den richtigen Taskmanager ist, jedenfalls für die Sparte Prozesse ;)
Werde morgen Rar-Packet mit Source und Exe posten. Die ProcessInfo-Unit brauchste nicht, ist eine Unit von Lucky und zwar aus seinem Sysinfo-Programm. Die bot aber leider nicht das was ich brauchte und daher habe ich das Programm von Grund auf selbst geschrieben. Der Quellcode ist in einer Unit, weil ich noch nicht wirklich Zeit zum ausgliedern und schön machen des Codes hatte...
Da das das erste Proggie ist, das ich "veröffentliche", muß ich beschämt zugeben, daß ich mich mit den Opensource - Lizensen usw nicht auskenne und daher, darf jeder den Code benutzen und wenn er mag, mit Verweiss auf mich =)

mfg Benjamin

PS: moin mehr dazu und wie gesagt Prog-Source+Exe

Olli 25. Jan 2007 22:01

Re: CPU auslastung der einzelnen Prozesse
 
Zitat:

Zitat von Darkmorph
Da das das erste Proggie ist, das ich "veröffentliche", muß ich beschämt zugeben, daß ich mich mit den Opensource - Lizensen usw nicht auskenne und daher, darf jeder den Code benutzen und wenn er mag, mit Verweiss auf mich =)

Dann erstmal Glueckwunsch zu deiner ersten Veroeffentlichung! :balloon:


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:24 Uhr.
Seite 1 von 2  1 2   

Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf