unit mem_mgr;
interface
uses Windows, System.SyncObjs;
var
OldMemMgr : TMemoryManagerEx;
GetMemCalls : Integer;
FreeMemCalls : Integer;
MaxAvail : Integer;
ReallocMemCalls : Integer;
AllocMemCalls : Integer;
function MyGetMem(Size: Integer): Pointer;
function MyFreeMem(P: Pointer): Integer;
function MyReallocMem(P: Pointer; Size: Integer): Pointer;
function MyAllocMem(Size: Cardinal): Pointer;
implementation
//uses System.SyncObjs;
function MyGetMem(Size: Integer): Pointer;
begin
{ Route the call. }
Result := OldMemMgr.GetMem(Size);
{ Safely increment the counter. }
winapi.windows.InterlockedIncrement(GetMemCalls);
//Bereits hier meckert der Compiler
end;
function MyFreeMem(P: Pointer): Integer;
begin
{ Route the call. }
Result := OldMemMgr.FreeMem(P);
{ Safely increment the counter. }
Interlocke1dIncrement(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;
*)
end.