GlobalMemoryStatus bz.w GlobalMemoryStatusEx

[RWarnecke]

Hallo zusammen,

ich habe folgenden Sourcecode Funktion im Internet gefunden. Nur kapiere ich den Sourcecode nicht so recht. Ich kann doch mit GlobalMemoryStatus bzw. GlobalMemoryStatusEx den Arbeitsspeicher u.s.w auslesen.

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
//
//  Den Arbeitsspeicher auslesen, wenn dieser mehr als 2 GB beträgt
//
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;

procedure TForm1.FormCreate(Sender: TObject);
var
  Status: TMemoryStatusEx;
begin
  Label1.Caption := 'Total RAM: ' + IntToStr(Status.ullTotalPhys);
  Label2.Caption := 'Verfügbar RAM: ' + IntToStr(Status.ullAvailPhys);
  Label3.Caption := 'Total Pagefile: ' + IntToStr(Status.ullTotalPageFile);
  Label4.Caption := 'Verfügbar Pagefile: ' + IntToStr(Status.ullAvailPageFile);
  Label5.Caption := 'Total Virtuell: ' + IntToStr(Status.ullTotalVirtual);
  Label6.Caption := 'Verfügbar Virtuell: ' + IntToStr(Status.ullAvailVirtual);
end;

Hier zeigt er mit komischerweise immer 0 in den Labels an. Kann mir das und den Sourcecode jemand erklären bitte ?

[Luckie]

Wo rufst du denn die Funktion auf? ;)

BTW brauchst du das nicht alles selber zu deklarieren, steht schon alles in der Windows.pas.

[DeddyH]

Das habe ich mich auch gefragt. :-D

[RWarnecke]

Zitat:

Zitat von Luckie

Wo rufst du denn die Funktion auf? ;)

BTW brauchst du das nicht alles selber zu deklarieren, steht schon alles in der Windows.pas.

Ich habe zuerst gedacht, das tue ich damit, wenn ich Status.ullTotalPhys aufrufe. Aber irgendwie scheint das ja nicht richtig zu sein. Ich muss ja den TMemoryStatusEx erst füllen oder nicht ? Aber wie fülle ich den ?

Ich möchte, dass er mit damit den physikalischen Arbeitsspeicher größer 2 GB anzeigt.

[DeddyH]

Wenn ich das richtig verstanden habe, musst Du als erste Zeile

Delphi-Quellcode:

GlobalMemoryStatusEx(Status);

einfügen.

[Luckie]

TMemoryStatusEx ist doch nur ein Record, der irgendwo gefüllt werden muss:

Delphi-Quellcode:

type
  TMemoryStatusEx = packed record
    dwLength: DWORD;
    dwMemoryLoad: DWORD;
    ullTotalPhys: Int64;
    ullAvailPhys: Int64;
    ullTotalPageFile: Int64;
    ullAvailPageFile: Int64;
    ullTotalVirtual: Int64;
    ullAvailVirtual: Int64;
    ullAvailExtendedVirtual: Int64;
  end;

function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): BOOL; stdcall; external kernel32;

procedure TForm1.Button1Click(Sender: TObject);
var
  Status: TMemoryStatusEx;
begin
  ZeroMemory(@Status, SizeOf(TMemoryStatusEx));
  Status.dwLength := SizeOf(TMemoryStatusEx);
  GlobalMemoryStatusEx(Status);
  Label1.Caption := 'Total RAM: ' + IntToStr(Status.ullTotalPhys);
  Label2.Caption := 'Verfügbar RAM: ' + IntToStr(Status.ullAvailPhys);
  Label3.Caption := 'Total Pagefile: ' + IntToStr(Status.ullTotalPageFile);
  Label4.Caption := 'Verfügbar Pagefile: ' + IntToStr(Status.ullAvailPageFile);
  Label5.Caption := 'Total Virtuell: ' + IntToStr(Status.ullTotalVirtual);
  Label6.Caption := 'Verfügbar Virtuell: ' + IntToStr(Status.ullAvailVirtual);
end;

[DeddyH]

Jepp, so sollte es richtig sein.

[RWarnecke]

Danke, jetzt galube ich es kapiert zu haben. So wie Luckie es geschrieben hat, funktioniert es einwandfrei. Danke, danke nochmals.

[NicoDE]

Zitat:

Zitat von RWarnecke

Hier zeigt er mit komischerweise immer 0 in den Labels an.

Die Definition von TMemoryStatusEx ist nicht korrekt (GetLastError gibt wahrscheinlich ERROR_INVALID_PARAMETER zurück ;)).

Man kann auch gleich die Fallback-Logik in eine eigene Funktion einbauen (anstatt sie immer wieder in der Anwendung zu implementieren):

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;

[Dirkmswt]

Du musst auch den Code vor den Labels übernehmen sonst wird der Wert auch immer 0 bleiben 8)
Ich hab 4Gb Ram und die werden Korrekt angezeigt.