RAM Auslastung ermitteln

[Matze]

So kann man sich die aktuelle RAM AUslastung in einer Progressbar anzeigen lassen:

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  x, y : real; 
  memory: TMemoryStatus; 
  Auslastung: integer; 
begin 
  memory.dwLength := SizeOf(memory); 
  GlobalMemoryStatus(memory); 
  x := memory.dwTotalPhys - memory.dwAvailPhys; 
  y := memory.dwTotalPhys; 
  Auslastung := round(((x/y)*100)); 
  ProgressBar1.Position := Auslastung; 
end;

Edit: Ich wurde von APP darauf hingewiesen, dass es TMemoryStatus erst ab D6 gibt.

[Matze]

NicoDE hat hier freundlichwerweise den Code für alle Delphi-Versionen veröffentlicht:

Delphi-Quellcode:

type 
  SIZE_T = Cardinal; 
  {$EXTERNALSYM SIZE_T} 
  DWORDLONG = Int64;  // ULONGLONG 
  {$EXTERNALSYM DWORDLONG} 

type 
  PMemoryStatus = ^TMemoryStatus; 
  LPMEMORYSTATUS = PMemoryStatus; 
  {$EXTERNALSYM LPMEMORYSTATUS} 
  _MEMORYSTATUS = packed record 
    dwLength       : DWORD; 
    dwMemoryLoad   : DWORD; 
    dwTotalPhys    : SIZE_T; 
    dwAvailPhys    : SIZE_T; 
    dwTotalPageFile: SIZE_T; 
    dwAvailPageFile: SIZE_T; 
    dwTotalVirtual : SIZE_T; 
    dwAvailVirtual : SIZE_T; 
  end; 
  {$EXTERNALSYM _MEMORYSTATUS} 
  TMemoryStatus = _MEMORYSTATUS; 
  MEMORYSTATUS = _MEMORYSTATUS; 
  {$EXTERNALSYM MEMORYSTATUS} 

type 
  PMemoryStatusEx = ^TMemoryStatusEx; 
  LPMEMORYSTATUSEX = PMemoryStatusEx; 
  {$EXTERNALSYM LPMEMORYSTATUSEX} 
  _MEMORYSTATUSEX = packed record 
    dwLength        : DWORD; 
    dwMemoryLoad    : DWORD; 
    ullTotalPhys    : DWORDLONG; 
    ullAvailPhys    : DWORDLONG; 
    ullTotalPageFile: DWORDLONG; 
    ullAvailPageFile: DWORDLONG; 
    ullTotalVirtual : DWORDLONG; 
    ullAvailVirtual : DWORDLONG; 
  end; 
  {$EXTERNALSYM _MEMORYSTATUSEX} 
  TMemoryStatusEx = _MEMORYSTATUSEX; 
  MEMORYSTATUSEX = _MEMORYSTATUSEX; 
  {$EXTERNALSYM MEMORYSTATUSEX} 

//--- 

procedure GlobalMemoryStatus(var lpBuffer: TMemoryStatus); stdcall; 
  external kernel32; 
{$EXTERNALSYM GlobalMemoryStatus} 

function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): BOOL; stdcall; 
type 
  TFNGlobalMemoryStatusEx = function(var msx: TMemoryStatusEx): BOOL; stdcall; 
var 
  FNGlobalMemoryStatusEx: TFNGlobalMemoryStatusEx; 
begin 
  FNGlobalMemoryStatusEx := TFNGlobalMemoryStatusEx( 
    GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx')); 
  if not Assigned(FNGlobalMemoryStatusEx) then 
  begin 
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED); 
    Result := False; 
  end 
  else 
    Result := FNGlobalMemoryStatusEx(lpBuffer); 
end;

Der Aufruf erfolgt mittels VCL so:

Delphi-Quellcode:

var Status: TMemoryStatus;

...

procedure TForm1.Button1Click(Sender: TObject);
begin
  GlobalMemoryStatus(Status);  //Werte zuweisen

  Memo1.Clear;
  Memo1.Alignment := tARightJustify;
  Memo1.Lines.Add('RAM gesamt: ' + IntToStr(Status.dwTotalPhys) + ' Bytes');
  Memo1.Lines.Add('RAM verfügbar: ' + IntToStr(Status.dwAvailPhys) + ' Bytes');
  Memo1.Lines.Add('Virtuell gesamt: ' + IntToStr(Status.dwTotalVirtual) + ' Bytes');
  Memo1.Lines.Add('Virtuell verfügbar: ' + IntToStr(Status.dwAvailVirtual) + ' Bytes');
end;

[CalganX]

NicoDE hat hier nochmal eine etwas veränderte Version bereit gestellt:

Delphi-Quellcode:

function MyGlobalMemoryStatus(var ABuffer: TMemoryStatusEx): BOOL; stdcall;
type
  TFNGlobalMemoryStatusEx = function(var ABuffer: TMemoryStatusEx): BOOL; stdcall;
const
  FallbackSize = $38;  // FieldOffset(TMemoryStatusEx, ullAvailExtendedVirtual)
{$WRITEABLECONST ON}
const
  Initialized: Integer = 0;
  FNMemStatEx: TFNGlobalMemoryStatusEx = nil;
{$WRITEABLECONST OFF}
var
  Status: TMemoryStatus;
begin
  if Initialized = 0 then
  begin
    FNMemStatEx := TFNGlobalMemoryStatusEx(
      GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx'));
    InterlockedIncrement(Initialized);
  end;
  if Assigned(FNMemStatEx) then
    Result := FNMemStatEx(ABuffer)
  else if ABuffer.dwLength < FallbackSize then
  begin
    SetLastError(ERROR_INVALID_PARAMETER);
    Result := False;
  end
  else
  begin
    FillChar(Status, SizeOf(TMemoryStatus), 0);
    GlobalMemoryStatus(Status);
    Result := (Status.dwLength = SizeOf(TMemoryStatus));
    if Result then
    begin
      FillChar(ABuffer, ABuffer.dwLength, 0);
      ABuffer.dwLength := FallbackSize;
      ABuffer.dwMemoryLoad := Status.dwMemoryLoad;
      with ABuffer, Status do
      begin
        TULargeInteger(ullTotalPhys).LowPart := dwTotalPhys;
        TULargeInteger(ullAvailPhys).LowPart := dwAvailPhys;
        TULargeInteger(ullTotalPageFile).LowPart := dwTotalPageFile;
        TULargeInteger(ullAvailPageFile).LowPart := dwAvailPageFile;
        TULargeInteger(ullTotalVirtual).LowPart := dwTotalVirtual;
        TULargeInteger(ullAvailVirtual).LowPart := dwAvailVirtual;
      end;
    end;
  end;
end;

Der Unterschied besteht darin, dass hier automatisch eine Fallback-Lösung auf GlobalMemoryStatus statt findet, wenn die entsprechende Ex-Version nicht verfügbar ist.

Anwendungsbeispiel:

Delphi-Quellcode:

var
  buf: TMemoryStatusEx;
begin
  buf.dwLength := SizeOf(TMemoryStatusEx);
  if (not MyGlobalMemoryStatus(buf)) then
    RaisLastOSError;

  Memo1.Lines.Clear;
  Memo1.Lines.Add('RAM verfügbar: ' + buf.ullTotalPhys + ' Bytes');
  // ...
end;