MemMgr (Delphi)

Description

This example demonstrates the use of SetMemoryManager and GetMemoryManager routines. Note that this example is thread safe.

Code

var
  OldMemMgr       : TMemoryManagerEx;
  GetMemCalls     : Integer;
  FreeMemCalls    : Integer;
  ReallocMemCalls : Integer;
  AllocMemCalls   : Integer;

function MyGetMem(Size: Integer): Pointer;
begin
  { Route the call. }
  Result := OldMemMgr.GetMem(Size);

  { Safely increment the counter. }
  InterlockedIncrement(GetMemCalls);
end;

function MyFreeMem(P: Pointer): Integer;
begin
  { Route the call. }
  Result := OldMemMgr.FreeMem(P);

  { Safely increment the counter. }
  InterlockedIncrement(FreeMemCalls);
end;

function MyReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  { Route the call. }
  Result := OldMemMgr.ReallocMem(P, Size);

  { Safely increment the counter. }
  InterlockedIncrement(ReallocMemCalls);
end;

function MyAllocMem(Size: Cardinal): Pointer;
begin
  { Route the call. }
  Result := OldMemMgr.AllocMem(Size);

  { Safely increment the counter. }
  InterlockedIncrement(AllocMemCalls);
end;

procedure TForm2.btPerformSomethingClick(Sender: TObject);
var
  X : Integer;
  I : ^Integer;
begin
  { Perform some allocations and free operations. }
  for X := 0 to 999 do
  begin
    New(I);
    Dispose(I);
  end;
end;

procedure TForm2.btUseMyMemMgrClick(Sender: TObject);
var
  MyMemMgr : TMemoryManagerEx;
begin
  { Switch button states. }
  btUseSystemMemMgr.Enabled := true;
  btUseMyMemMgr.Enabled := false;

  { Get the old memory manager. }
  GetMemoryManager(OldMemMgr);

  { Create your instance. }
  MyMemMgr.GetMem := MyGetMem;
  MyMemMgr.FreeMem := MyFreeMem;
  MyMemMgr.ReallocMem := MyReallocMem;
  MyMemMgr.AllocMem := MyAllocMem;

  { Use the defaults for this--not important. }
  MyMemMgr.RegisterExpectedMemoryLeak := OldMemMgr.RegisterExpectedMemoryLeak;
  MyMemMgr.UnregisterExpectedMemoryLeak := OldMemMgr.UnregisterExpectedMemoryLeak;

  { Clear out the count variables. }
  GetMemCalls := 0;
  FreeMemCalls := 0;
  ReallocMemCalls := 0;
  AllocMemCalls := 0;

  { Install the new memory manager. }
  SetMemoryManager(MyMemMgr);
end;

procedure TForm2.btUseSystemMemMgrClick(Sender: TObject);
begin
  { Switch button states. }
  btUseSystemMemMgr.Enabled := false;
  btUseMyMemMgr.Enabled := true;

  { Set the old memory manager back. }
  SetMemoryManager(OldMemMgr);

  GetMemCalls := 0;
  FreeMemCalls := 0;
  ReallocMemCalls := 0;
  AllocMemCalls := 0;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  { Set the old memory manager back. }
  if IsMemoryManagerSet then
     SetMemoryManager(OldMemMgr);
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  {
  Note that IntToStr calls will also Allocate/Free
  memory so that at each timer tick the counts is increased.
  }
  Form2.edtGetMemCalls.Text := IntToStr(GetMemCalls);
  Form2.edtFreeMemCalls.Text := IntToStr(FreeMemCalls);
  Form2.edtReallocMemCalls.Text := IntToStr(ReallocMemCalls);
  Form2.edtAllocMemCalls.Text := IntToStr(AllocMemCalls);
end;

Uses

• System.SetMemoryManager ( fr | de | ja )
• System.GetMemoryManager ( fr | de | ja )
• System.IsMemoryManagerSet ( fr | de | ja )
• System.TMemoryManagerEx ( fr | de | ja )