CPU auslastung der einzelnen Prozesse

[Luckie]

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]

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]

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.

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

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

[Sidorion]

Hat er doch

Zitat von Darkmorph:

mfg
Benjamin Loschke

[Luckie]

Wer achtet denn auf so was? Aber wir schweifen ab.

[Darkmorph]

tja,

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]

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]

Ok, hab ich angepasst. Auch wenn ich sagen muß, das beides genauso gut/schlecht funzt...

[Luckie]

Ups noch was: Du solltest am Ende von Destroy noch inherited aufrufen, um den original Destruktor aufzurufen und auszuführen.

[Darkmorph]

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