{-------------------------------------------------------------}
{----Purpose : VCL wrapper for GlobalMemoryStatus API.        }
{    By      : Ir. G.W. van der Vegt                          }
{    For     : Myself                                         }
{-------------------------------------------------------------}
{ ddmmyy   comment                                            }
{ -------- ---------------------------------------------------}
{ 07052001-Initial version.                                   }
{ 08052001-Corrected ByteToMByte Function.                    }
{ 23052005-Added stored false to all properties to prevent    }
{          storage of values in dfm files.                    }
{ 19062005-madshi: now works as a madExcept 3.0 plugin        }
{ 10072005-madshi: some little adjustments for new 3.0 beta   }
{-------------------------------------------------------------}

unit MemoryInfo;

interface

function GetExtendedMemoryReport : string;

implementation

uses Windows, madExcept, madDumpObj;

{$M+}

type
  TMemoryInfo = class
  private
    { Private declarations }
    fMemoryStatus: TMemoryStatus;
    function GetAvailPageFile: Dword;
    function GetAvailPhysicalMemory: Dword;
    function GetAvailVirtualMemory: Dword;
    function GetMemoryLoad: Dword;
    function GetTotalPageFile: Dword;
    function GetTotalPhysicalMemory: Dword;
    function GetTotalVirtualMemory: Dword;
  protected
    { Protected declarations }
    procedure UpdateMemoryStatus;
  public
    { Public declarations }
    constructor Create; 
    function BytesToKBytes(Value: Dword): Dword;
    function BytesToMBytes(Value: Dword): Dword;
  published
    { Published declarations }
    property TotalPhysicalMemory: Dword read GetTotalPhysicalMemory;
    property AvailPhysicalMemory: Dword read GetAvailPhysicalMemory;
    property TotalPageFile: Dword read GetTotalPageFile;
    property AvailPageFile: Dword read GetAvailPageFile;
    property TotalVirtualMemory: Dword read GetTotalVirtualMemory;
    property AvailVirtualMemory: Dword read GetAvailVirtualMemory;
    property MemoryLoad: Dword read GetMemoryLoad;
  end;

{$M-}

{ TMemoryInfo }

constructor TMemoryInfo.Create;
begin
  inherited;

  UpdateMemoryStatus();
end;

procedure TMemoryInfo.UpdateMemoryStatus;
begin
  ZeroMemory(@fMemoryStatus, Sizeof(TMemoryStatus));

  fMemoryStatus.dwLength := Sizeof(TMemoryStatus);
  GlobalMemoryStatus(fMemoryStatus);
end;

function TMemoryInfo.BytesToKBytes(Value: Dword): Dword;
begin
  Result := Value div 1024;
end;

function TMemoryInfo.BytesToMBytes(Value: Dword): Dword;
begin
  Result := Value div (1024 * 1000);
end;

function TMemoryInfo.GetAvailPageFile: Dword;
begin
  UpdateMemoryStatus();
  Result := fMemoryStatus.dwAvailPageFile;
end;

function TMemoryInfo.GetAvailPhysicalMemory: Dword;
begin
  UpdateMemoryStatus();
  Result := fMemoryStatus.dwAvailPhys;
end;

function TMemoryInfo.GetAvailVirtualMemory: Dword;
begin
  UpdateMemoryStatus();
  Result := fMemoryStatus.dwAvailVirtual;
end;

function TMemoryInfo.GetTotalPageFile: Dword;
begin
  UpdateMemoryStatus();
  Result := fMemoryStatus.dwTotalPageFile;
end;

function TMemoryInfo.GetTotalPhysicalMemory: Dword;
begin
  UpdateMemoryStatus();
  Result := fMemoryStatus.dwTotalPhys;
end;

function TMemoryInfo.GetTotalVirtualMemory: Dword;
begin
  UpdateMemoryStatus();
  Result := fMemoryStatus.dwTotalVirtual;
end;

function TMemoryInfo.GetMemoryLoad: Dword;
begin
  UpdateMemoryStatus();
  Result := fMemoryStatus.dwMemoryLoad;
end;

function GetExtendedMemoryReport : string;
var mi : TMemoryInfo;
begin
  mi := TMemoryInfo.Create;
  result := DumpObj(mi);
  mi.Free;
end;

initialization
  RegisterBugReportPlugin('memory info', 'extended memory information', GetExtendedMemoryReport);
finalization
  UnregisterBugReportPlugin('memory info');
end.