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

CPU auslastung der einzelnen Prozesse

Ein Thema von F.Art · begonnen am 3. Dez 2004 · letzter Beitrag vom 26. Jan 2007
Antwort Antwort
Seite 2 von 2     12
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#11

Re: CPU auslastung der einzelnen Prozesse

  Alt 25. Jan 2007, 22:58
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.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Darkmorph

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

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 09:18
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
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#13

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 09:51
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?
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Sidorion

Registriert seit: 23. Jun 2005
403 Beiträge
 
#14

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 11:21
Hat er doch
Zitat von Darkmorph:
mfg
Benjamin Loschke
Manchmal sehen Dinge, die wie Dinge aussehen wollen mehr wie Dinge aus, als Dinge
<Esmerelda Wetterwachs>
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#15

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 11:23
Wer achtet denn auf so was? Aber wir schweifen ab.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Darkmorph

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

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 11:36
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
Angehängte Dateien
Dateityp: rar mytaskmanager_v0.3_163.rar (215,4 KB, 74x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#17

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 11:43
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;
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Darkmorph

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

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 11:50
Ok, hab ich angepasst. Auch wenn ich sagen muß, das beides genauso gut/schlecht funzt...
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#19

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 11:54
Ups noch was: Du solltest am Ende von Destroy noch inherited aufrufen, um den original Destruktor aufzurufen und auszuführen.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Darkmorph

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

Re: CPU auslastung der einzelnen Prozesse

  Alt 26. Jan 2007, 13:46
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 02:29 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf