Delphi-PRAXiS

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 13: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 13: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 14: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 16: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 19: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 21: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 14: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 17: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 20: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 21: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:

Luckie 25. Jan 2007 21:58

Re: CPU auslastung der einzelnen Prozesse
 
Ich würde mir eine Funktion wünschen, de rman nur die ProzessID übergibt und bekommt dann die Auslastung in Prozent.

Und zu den Kommentaren: Ich finde es ist etwas zu viel des Guten:
Delphi-Quellcode:
  //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;
Das ist Quatsch so was zu kommentieren:
Code:
lKernel[b]Time[/b] := lNewKernel[b]Time[/b] - lOldKernel[b]Time[/b];
lUser[b]Time[/b] := lNewUser[b]Timer[/b] - lOldUser[b]Time[/b];
und schon sind die Kommentare überflüssig.

Darkmorph 26. Jan 2007 08:18

Re: CPU auslastung der einzelnen Prozesse
 
Hi Micha,

wie ich gestern schon gesagt habe "War mehr oder weniger nur, um zu schauen ob ich die Nuss knacke". Deshalb ist der Code 'ne Katastrophe, der Herr Johlen hätte wahrscheinlich eine volle Blockstunde damit zu tun, meine Objektunorientiertheit zu kommentieren ;)
Mache mich jetzt daran eine Klasse zu bauen, die die Arbeit erledigt und nebenbei wird sich damit dann auch deine Anfrage erledigen...

Da das noch ein wenig Zeit in Anspruch nehmen wird, da ich tatsächlich heute auch noch andere Sachen an der Arbeit zu tun habe, rechne ich mit einem ersten Release nicht vor 14:00h :)


MfG Benjamin

Luckie 26. Jan 2007 08:51

Re: CPU auslastung der einzelnen Prozesse
 
Zitat:

Zitat von Darkmorph
der Herr Johlen hätte wahrscheinlich

Jetzt weiß ich, woher mir der Nick Darkmorph so bekannt vorkommt, der steht als E-Mail Adresse in unserer Excel-Klassenliste. :wall:

Hättest ja mal was sagen können, dass du Benjamin bist. :roll:

Aber seit wann hast du was an der Arbeit zu tun und das an einem Freitag? ;)

Sidorion 26. Jan 2007 10:21

Re: CPU auslastung der einzelnen Prozesse
 
Hat er doch :twisted:
Zitat:

Zitat von Darkmorph
mfg
Benjamin Loschke


Luckie 26. Jan 2007 10:23

Re: CPU auslastung der einzelnen Prozesse
 
Wer achtet denn auf so was? :oops: Aber wir schweifen ab.

Darkmorph 26. Jan 2007 10:36

Re: CPU auslastung der einzelnen Prozesse
 
Liste der Anhänge anzeigen (Anzahl: 1)
tja,

Zitat:

Zitat von Luckie
Aber seit wann hast du was an der Arbeit zu tun und das an einem Freitag? ;)

hat sich rausgestellt, dass mein chef mir nur angst machen wollte ;)
Hier mein Proggie in der vorläufigen Version 0.3.1.1 :)

vorab TODO:
bei einigen Prozessen wird nicht die Ordnungsgemäße MemoryUsage wiedergegeben.

So und nun testet und macht mich auf Fehlerchen aufmerksam.

Für alle die hier nicht Registriert sind und deswegen nicht das Attachment laden können, hier der Code zu meiner Arbeiter-Klasse:


Delphi-Quellcode:
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.
freue mich immer auf konstruktive Kritik.


Mit freundlichen Grüßen
Benjamin Loschke

Luckie 26. Jan 2007 10:43

Re: CPU auslastung der einzelnen Prozesse
 
Der Destruktor ist eigentlich immer Destroy:
Delphi-Quellcode:
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 Destroy; override; <<<
      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;

Darkmorph 26. Jan 2007 10:50

Re: CPU auslastung der einzelnen Prozesse
 
Ok, hab ich angepasst. Auch wenn ich sagen muß, das beides genauso gut/schlecht funzt... :P

Luckie 26. Jan 2007 10:54

Re: CPU auslastung der einzelnen Prozesse
 
Ups noch was: Du solltest am Ende von Destroy noch inherited aufrufen, um den original Destruktor aufzurufen und auszuführen.

Darkmorph 26. Jan 2007 12:46

Re: CPU auslastung der einzelnen Prozesse
 
hab ich gemacht... so, da den admins es bestimmt nicht gefällt, wenn ich hier eine datei nach der anderen hochlade, hab ich mein Prog jetzt unter der Sparte OPEN-SOURCE vorgestellt. Hier der Link:
http://www.delphipraxis.net/internal...t.php?t=101832

Bitte weiterhin konstruktiv Fehler und Feature-Requests posten ;)


mfg
Benjamin


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:00 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