unit MemWatch;
// June 1999 by Maarten Pennings

// Add this unit as the *first* of your project.
// That is all there is to it!
//
// Example:
//
//    program MaartenPennings;
//
//    uses
//      MemWatch, // <<<<<<========= IT IS HERE
//      Forms,
//      main in 'main.pas' {Form1};
//
//    {$R *.RES}
//
//    begin
//      Application.Initialize;
//      Application.CreateForm(TForm1, Form1);
//      Application.Run;
//    end.


interface

// Yes, all machinary is hidden!

implementation

uses
  windows, sysutils;

var
  MwOld:TMemoryManager;

var
  MwSize:Integer;
  MwCount:Integer;
  MwMaxSize:Integer;
  MwMaxCount:Integer;

// Auxilary function

function MemBlockSize(p:Pointer):Integer;
begin
  Result:=PInteger(integer(p)-4)^ and not 3
end;

// New memory manager functions

function MwGetMem(size:Integer):Pointer;
begin
  Result:=MwOld.GetMem(size);
  Inc(MwCount);
  if MwCount>MwMaxCount then MwMaxCount:=MwCount;
  Inc(MwSize,MemBlockSize(Result));
  if MwSize>MwMaxSize then MwMaxSize:=MwSize;
end;

function MwFreeMem(ptr:Pointer):Integer;
begin
  Dec(MwSize,MemBlockSize(ptr));
  Dec(MwCount);
  Result:=MwOld.FreeMem(ptr)
end;

function MwReallocMem(ptr:Pointer;size:Integer):Pointer;
begin
  Dec(MwSize,MemBlockSize(ptr));
  Result:=MwOld.ReallocMem(ptr,size);
  Inc(MwSize,MemBlockSize(Result));
  if MwSize>MwMaxSize then MwMaxSize:=MwSize;
end;

// Entry and exit

var
  MwNew:TMemoryManager=(GetMem:MwGetMem; FreeMem:MwFreeMem; ReallocMem:MwReallocMem);
  MwNow: TDateTime;

initialization
  MwSize:=0;
  MwCount:=0;
  GetMemoryManager(MwOld);
  SetMemoryManager(MwNew);
  MwNow:=Now;
finalization
  MwNow:=Now-MwNow;
  SetMemoryManager(MwOld);
  MessageBox(0,PChar(Format(
    'Memory still allocated: %d bytes in %d blocks '#13+
    'Max allocated: %d bytes and/or %d blocks'#13+
    'Runtime: %f sec',
    [MwSize,MwCount,MwMaxSize,MwMaxCount,MwNow*24*60*60])),
    'Run diagnostics',
    MB_OK+
      MB_ICONWARNING*Ord(MwSize>0)+
      MB_ICONINFORMATION*Ord(MwSize=0)
    )
end.