GlobalMemoryStatus bz.w GlobalMemoryStatusEx

[NicoDE]

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;