AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi CPU auslastung der einzelnen Prozesse
Thema durchsuchen
Ansicht
Themen-Optionen

CPU auslastung der einzelnen Prozesse

Ein Thema von F.Art · begonnen am 3. Dez 2004 · letzter Beitrag vom 26. Jan 2007
Antwort Antwort
Seite 1 von 2  1 2      
F.Art

Registriert seit: 12. Jan 2003
26 Beiträge
 
Delphi 7 Enterprise
 
#1

CPU auslastung der einzelnen Prozesse

  Alt 3. Dez 2004, 14:01
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?
  Mit Zitat antworten Zitat
Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: CPU auslastung der einzelnen Prozesse

  Alt 3. Dez 2004, 14:05
Code zum Auflisten und Beenden der Prozesse findest du in der Code-Library: [cl]prozess*[/cl]
  Mit Zitat antworten Zitat
F.Art

Registriert seit: 12. Jan 2003
26 Beiträge
 
Delphi 7 Enterprise
 
#3

Re: CPU auslastung der einzelnen Prozesse

  Alt 3. Dez 2004, 15:49
Das auflisten und killen klappt nun.
Aber was nocht fehlt ist das er die CPU Auslastung hinter jedem Prozess bei schreibt.
  Mit Zitat antworten Zitat
supermuckl

Registriert seit: 1. Feb 2003
1.340 Beiträge
 
FreePascal / Lazarus
 
#4

Re: CPU auslastung der einzelnen Prozesse

  Alt 3. Dez 2004, 17:36
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.
Das echte Leben ist was für Leute...
... die im Internet keine Freunde finden!
  Mit Zitat antworten Zitat
ElectricalFire

Registriert seit: 20. Dez 2004
Ort: Zürich
19 Beiträge
 
Delphi 2005 Architect
 
#5

Re: CPU auslastung der einzelnen Prozesse

  Alt 19. Jun 2005, 20:00
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
  Mit Zitat antworten Zitat
Olli
(Gast)

n/a Beiträge
 
#6

Re: CPU auslastung der einzelnen Prozesse

  Alt 19. Jun 2005, 22:01
Mit dem Source von PView2 kannst du im Übrigen sehen, wie es auch ohne "Kompos" lösbar ist
  Mit Zitat antworten Zitat
Darkmorph

Registriert seit: 24. Mär 2003
37 Beiträge
 
Delphi 6 Professional
 
#7

Re: CPU auslastung der einzelnen Prozesse

  Alt 25. Jan 2007, 15:59
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
  Mit Zitat antworten Zitat
Olli
(Gast)

n/a Beiträge
 
#8

Re: CPU auslastung der einzelnen Prozesse

  Alt 25. Jan 2007, 18:40
Jetzt waere es noch ideal, wenn du dazuschreiben wuerdest, unter welchen Lizenzbedingungen dein Code benutzt wird. Ansonsten, alles in allem gute Arbeit! ... 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.
  Mit Zitat antworten Zitat
Darkmorph

Registriert seit: 24. Mär 2003
37 Beiträge
 
Delphi 6 Professional
 
#9

Re: CPU auslastung der einzelnen Prozesse

  Alt 25. Jan 2007, 21:55
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
  Mit Zitat antworten Zitat
Olli
(Gast)

n/a Beiträge
 
#10

Re: CPU auslastung der einzelnen Prozesse

  Alt 25. Jan 2007, 22:01
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!
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:37 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz