Speicherauslastung eines beliebigen Prozesses anzeigen

[Patrick]

Hallo, ich habe folgendes Problem.

Ich will auslesen, wieviel Speicher ein Prozess benötigt. Die Prozesse sammt Prozess ID und den anderen Kram anzuzeigen ist kein Problem. Ich habe auch schon eine Prozedur gefunden, mit der die Speicherauslastung des Prozesses in der ich die Prozedur ausführe anzeigen kann, aber an die anderen komm ich nicht ran...

Delphi-Quellcode:

uses psAPI; 

procedure TForm1.Button2Click(Sender: TObject);
var 
  pmc: PPROCESS_MEMORY_COUNTERS; 
  cb: Integer; 
begin 
  cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
  GetMem(pmc, cb);
  pmc^.cb := cb;
  if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
    Label1.Caption := IntToStr(pmc^.WorkingSetSize) + ' Bytes'
  else 
    Label1.Caption := 'Unable to retrieve memory usage structure'; 

  FreeMem(pmc);
end;

Wie kann ich diese Prozedur so abändern, dass sie mir die Speicherauslastung von jedem beliebigen Prozess anzeigt?

[c113plpbr]

Wenn du GetCurrentProcess() durch OpenProcess(...) ersetzt, könntest du vielleicht zum ziel kommen ...
Sagen wir so: es sollte funktionieren ...

[Patrick]

Ich hab mal ein paar Kombinationen getestet, leider führten sie nicht zum Ziel.
Die Betreffende Zeile sieht jetzt so aus:
if GetProcessMemoryInfo(OpenProcess(1, BOOL(0), PrID), pmc, cb) then

[c113plpbr]

Du musst dir einen anderen dwDesiredAccess -Flag suchen. Ich hab das so gelöst:
if GetProcessMemoryInfo(OpenProcess(PROCESS_ALL_ACCESS,false,1012), pmc, cb) then 1012 is nur ne gültige PID, bei mir im moment ...
Es gibt folgende Flags:

MSDN

PROCESS_ALL_ACCESS Specifies all possible access flags for the process object.
PROCESS_CREATE_PROCESS Used internally.
PROCESS_CREATE_THREAD Enables using the process handle in the CreateRemoteThread function to create a thread in the process.
PROCESS_DUP_HANDLE Enables using the process handle as either the source or target process in the DuplicateHandle function to duplicate a handle.
PROCESS_QUERY_INFORMATION Enables using the process handle in the GetExitCodeProcess and GetPriorityClass functions to read information from the process object.
PROCESS_SET_INFORMATION Enables using the process handle in the SetPriorityClass function to set the priority class of the process.
PROCESS_TERMINATE Enables using the process handle in the TerminateProcess function to terminate the process.
PROCESS_VM_OPERATION Enables using the process handle in the VirtualProtectEx and WriteProcessMemory functions to modify the virtual memory of the process.
PROCESS_VM_READ Enables using the process handle in the ReadProcessMemory function to read from the virtual memory of the process.
PROCESS_VM_WRITE Enables using the process handle in the WriteProcessMemory function to write to the virtual memory of the process.
SYNCHRONIZE Windows NT: Enables using the process handle in any of the wait functions to wait for the process to terminate.

Ich hoffe, dass es jetzt funktioniert ...

ciao, Philipp

[Patrick]

Das funst immer noch nicht!

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  pmc: PPROCESS_MEMORY_COUNTERS;
  cb: Integer;
  PrID: Integer; // processidentifier
begin
  PrID := StrToInt('$' + Listbox2.Items.Strings[Listbox1.Itemindex]);

  cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
  GetMem(pmc, cb);
  pmc^.cb := cb;
  if GetProcessMemoryInfo(OpenProcess(PROCESS_ALL_ACCESS, false, PrID), pmc, cb) then
    Label1.Caption := IntToStr(pmc^.WorkingSetSize) + ' Bytes'
  else
    Label1.Caption := 'Unable to retrieve memory usage structure';

  FreeMem(pmc);
end;

In der Listbox2 stehen die Prozess IDs (z.B. 0340). Eigentlich müsste es doch langsam mal laufen...

[c113plpbr]

Aha ... da liegt der fehler:
PrID := StrToInt('$' + Listbox2.Items.Strings[Listbox1.Itemindex]); Die PID (ProcessID) ist nicht hexadezimal! Es ist eine einfache, ganze Zahl! Mit '$' gibst du aber an, dass es eine Hexadezimalzahl ist! Ändere das, und es sollte funktionieren.

ciao, Philipp

[Christian Seehase]

Moin Philipp,

Zitat von c113plpbr:

Die PID (ProcessID) ist nicht hexadezimal!

und aus welcher Stelle in Patricks Source hast Du entnommen, dass er die PID nicht hexadezimal in der Listbox stehen hat?

[Patrick]

Doch, die PIDs sind Hexa-Dezimal! Ich hatte halt eine angegeben, die nicht Hexa-Dezimal aussieht...

[Christian Seehase]

Moin Patrick,

leider hast Du bislang nicht angegeben, was nicht funktioniert.
Am besten schreibst Du mal im else Zweig

ShowMessage(SysErrorMessage(GetLastError)); um eine nähere Beschreibung zu bekommen, was nicht geklappt hat.
Ausserdem solltest Du bei OpenProcess mal PROCESS_QUERY_INFORMATION verwenden, statt PROCESS_ALL_ACCESS.
Letzteres geht bei Systemprozessen schief, da hier die Zugriffsrechte nicht ausreichen.

Auch sollte man OpenProcess keinesfalls so als Parameter verwenden, da das zurückgegebene Handle auch wieder geschlossen werden muss.
Das Ganze könnte z.B. so aussehen:

Delphi-Quellcode:

var
  pmc   : PPROCESS_MEMORY_COUNTERS;
  cb    : Integer;
  PrID  : Integer; // processidentifier
  hProc : DWORD;

begin
  PrID := 8;
  cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
  pmc := AllocMem(cb);
  try
    pmc^.cb := cb;
    hProc := OpenProcess(PROCESS_QUERY_INFORMATION, false, PrID);
    if hProc <> 0 then begin
      try
        if GetProcessMemoryInfo(hProc, pmc, cb) then begin
          ShowMessage(IntToStr(pmc^.WorkingSetSize) + ' Bytes');
        end else begin
          ShowMessage(SysErrorMessage(GetLastError));;
        end;
      finally
        CloseHandle(hProc);
      end;
    end;
  finally
    FreeMem(pmc,SizeOf(_PROCESS_MEMORY_COUNTERS));
  end;
end;

[Patrick]

Also sieht der Quellcode jetzt so aus:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  pmc: PPROCESS_MEMORY_COUNTERS;
  cb: Integer;
  PrID: Integer; // processidentifier
begin
  PrID := StrToInt('$' + Listbox2.Items.Strings[Listbox1.Itemindex]);

  cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
  GetMem(pmc, cb);
  pmc^.cb := cb;
  if GetProcessMemoryInfo(OpenProcess(PROCESS_QUERY_INFORMATION, false, PrID), pmc, cb) then
    Label1.Caption := IntToStr(pmc^.WorkingSetSize) + ' Bytes'
  else
    Label1.Caption := 'Unable to retrieve memory usage structure';
    ShowMessage(SysErrorMessage(GetLastError));

  FreeMem(pmc);
end;

dann funktioniert es Teilweise, mit 3 verschiedenen Fehlermeldungen, bei verschiedenen Prozessen:
1. Das Fenster hat keine Bildlaufleisten /mal eine interessante Meldung
2. Das Handle ist ungültig
3. irgendetwas mit nugülter Klasse / nur selten, fast willkürlich

Zu bemerken ist, dass nur bei der zweiten Meldung nix gescheites angezeigt wird, mit den anderen geht es.

Bei dem Quellcode von Christian funktioniert es nahezu bei jedem Prozess. Ich hab dann noch ein

Delphi-Quellcode:

    hProc := OpenProcess(PROCESS_QUERY_INFORMATION, false, PrID);
    if hProc <> 0 then begin
    ...
    else ShowMessage(SysErrorMessage(GetLastError));

eingebaut und festgestellt, dass dies (bei z.B. svchost.exe die zwei von vier Prozessen die vom SYSTEM ausgeführt werden) ein "Zugriff verweigert" ergibt. Dies war wohl beim obrigen Quellcode der selbe Fehler, halt durch eine andere Fehlermeldung ausgedrückt.