Speicherauslastung eines beliebigen Prozesses anzeigen

[toms]

Hi,

Habe ein VB Funktion gefunden, um die Speicherauslastung eines Prozesses anzuzeigen.

Code:

Function GetProcessMemUsage(hprocess As Long) As Long
   Dim lpMem As Long
   Dim lPrivateBytes As Long
   Dim ret&
   Dim si As SYSTEM_INFO
   Dim mbi As MEMORY_BASIC_INFORMATION
   Dim lLenMbi&
   GetProcessMemUsage = -1
   lLenMbi = Len(mbi)
   Call GetSystemInfo(si)
   lpMem = si.lpMinimumApplicationAddress
   While lpMem < si.lpMaximumApplicationAddress
       mbi.RegionSize = 0
       ret = VirtualQueryEx(hprocess, lpMem, mbi, lLenMbi)
       If ret = lLenMbi Then
           If ((mbi.lType = MEM_private) And (mbi.State = MEM_COMMIT)) Then ' this block is In use by this process
               lPrivateBytes = lPrivateBytes + mbi.RegionSize
           End If
           On Error GoTo Finished
           lpMem = mbi.BaseAddress + mbi.RegionSize
           On Error GoTo 0
       Else
           Exit Function
       End If
   Wend
Finished:
   GetProcessMemUsage = lPrivateBytes
End Function

Hier ein quick & dirty Übersetzung nach Delphi:

Delphi-Quellcode:

function GetProcessMemUsage(hprocess: THandle) : Longint;
var
   lpMem : Cardinal;
   lPrivateBytes : Longint;
   ret:DWORD;
   si : TSystemInfo;
   mbi : TMemoryBasicInformation;
   lLenMbi: DWORD;
   x: Integer;
begin
   GetProcessMemUsage := -1;
   lLenMbi := SizeOf(mbi);
   GetSystemInfo(si);
   lpMem := Cardinal(si.lpMinimumApplicationAddress);
   while DWORD(lpMem) < DWORD(si.lpMaximumApplicationAddress) do
   begin
       mbi.RegionSize := 0;
       ret := VirtualQueryEx(hprocess, Pointer(lpMem), mbi, lLenMbi);
       If ret = lLenMbi Then
       begin
           If ((mbi.Type_9 = MEM_private) and (mbi.State = MEM_COMMIT)) then // this block is In use by this process
           begin
               lPrivateBytes := lPrivateBytes + mbi.RegionSize
           end; {if}
           lpMem := DWORD(mbi.BaseAddress) + DWORD(mbi.RegionSize);
       end else
       begin
          Result := lPrivateBytes;
          Exit;
       end;
   end; {while}
     Result := lPrivateBytes;
end;

Problem: GetProcessMemoryInfo & GetProcessMemUsage geben nicht den gleichen Rückgabewert.
Gibt wahrscheinlich einen (oder mehrere Fehler) in der Übersetzung oder die Funktion stimmt nicht ganz.