Освобождение памяти

Code:

unit MemMan;

interface

var

GetMemCount, FreeMemCount,

   ReallocMemCount: Integer;

implementation

uses

Windows, SysUtils;

var

OldMemMgr: TMemoryManager;

function NewGetMem(Size: Integer): Pointer;

begin

Inc(GetMemCount);

Result := OldMemMgr.GetMem(Size);

end;

function NewFreeMem(P: Pointer): Integer;

begin

Inc(FreeMemCount);

Result := OldMemMgr.FreeMem(P);

end;

function NewReallocMem(P: Pointer; Size: Integer): Pointer;

begin

Inc(ReallocMemCount);

Result := OldMemMgr.ReallocMem(P, Size);

end;

const

NewMemMgr: TMemoryManager = (

   GetMem: NewGetMem;

   FreeMem: NewFreeMem;

   ReallocMem: NewReallocMem);

initialization

GetMemoryManager(OldMemMgr);

SetMemoryManager(NewMemMgr);

finalization

SetMemoryManager(OldMemMgr);

if (GetMemCount - FreeMemCount) <> 0 then

   MessageBox(0, pChar(

     'Objects left: ' + IntToStr(GetMemCount - FreeMemCount)),

     'MemManager', mb_ok);

end.

unit MemForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

   BtnRefresh1: TButton;

   BtnCreateNil: TButton;

   BtnCreateOwner: TButton;

   BtnGetMem: TButton;

   LblResult: TLabel;

   Btn100Strings: TButton;

   Bevel1: TBevel;

   BtnRefresh2: TButton;

   procedure BtnRefresh1Click(Sender: TObject);

   procedure BtnCreateNilClick(Sender: TObject);

   procedure BtnCreateOwnerClick(Sender: TObject);

   procedure BtnGetMemClick(Sender: TObject);

   procedure FormCreate(Sender: TObject);

   procedure Btn100StringsClick(Sender: TObject);

   procedure BtnRefresh2Click(Sender: TObject);

public

   procedure Refresh;

   procedure Refresh2;

end;

var

Form1: TForm1;

implementation

uses MemMan;

{$R *.DFM}

procedure TForm1.Refresh;

begin

LblResult.Caption :=

   'Allocated: ' + IntToStr(GetMemCount) + #13 +

   'Free: ' + IntToStr(FreeMemCount) + #13 +

   'Existing: ' +

   IntToStr(GetMemCount - FreeMemCount) + #13 +

   'Re-allocated: ' + IntToStr(ReallocMemCount);

end;

procedure TForm1.Refresh2;

begin

LblResult.Caption := Format(

   'Allocated: %d'#13'Free: %d'#13'Existing: %d'#13'Re-allocated %d'      ,

   [GetMemCount, FreeMemCount,

   GetMemCount - FreeMemCount, ReallocMemCount]);

end;

procedure TForm1.BtnRefresh1Click(Sender: TObject);

begin

Refresh;

end;

procedure TForm1.BtnCreateNilClick(Sender: TObject);

begin

TButton.Create(nil);

Refresh;

end;

procedure TForm1.BtnCreateOwnerClick(Sender: TObject);

begin

TButton.Create(self);

Refresh;

end;

procedure TForm1.BtnGetMemClick(Sender: TObject);

var

P: Pointer;

begin

GetMem(P, 100);

Integer(P^) := 0;

Refresh;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Refresh;

end;

procedure TForm1.Btn100StringsClick(Sender: TObject);

var

s1, s2: string;

I: Integer;

begin

s1 := 'hi';

s2 := Btn100Strings.Caption;

for I := 1to100 do

   s1 := s1 + ': hello world';

Btn100Strings.Caption := s1;

s1 := s2;

Btn100Strings.Caption := s1;

Refresh;

end;

procedure TForm1.BtnRefresh2Click(Sender: TObject);

begin

Refresh2;

end;

end.