GetProcessMemoryInfo mit VirtualQueryEx

[toms]

Delphi-Quellcode:

Hi,

GetProcessMemUsage1 liefert die Speicheraulastung eines Prozesses.
GetProcessMemUsage2 sollte das gleiche tun, nur gibt es ein nicht korrektes Ergebnis zurück.
Wo liegt der Fehler in GetProcessMemUsage2?

uses
  PsAPI;

function GetProcessMemUsage1(hprocess: THandle): Longint;
var
  pmc: PPROCESS_MEMORY_COUNTERS;
  cb: Integer;
begin
  Result := -1;
  cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
  GetMem(pmc, cb);
  try
    pmc^.cb := cb;
    if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
      Result := pmc^.WorkingSetSize;
  finally
    FreeMem(pmc);
  end;
end;

function GetProcessMemUsage2(hprocess: THandle): Longint;
var
  lpMem: Cardinal;
  lPrivateBytes: Longint;
  ret: DWORD;
  si: TSystemInfo;
  mbi: TMemoryBasicInformation;
  lLenMbi: DWORD;
  x: Integer;
begin
  Result  := -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;


// Zum Testen:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := Format('%d Bytes', [GetProcessMemUsage1(GetCurrentProcess)]);
  Label2.Caption := Format('%d Bytes', [GetProcessMemUsage2(GetCurrentProcess)]);
end;