type

TSafeObject=class
public
  constructor Create;
  destructor Destroy; override;
end;

TGarbageCollector=class
private
  FObjects:tlist;
  FObjectsSaved:tlist;
  FSaveRepFileName:tfilename;
  FReport:tstringlist;
  FSectionStarted:boolean;
  FSectionsCount:integer;
  FTwiceDestroyedObjectsCount:integer;
  FTotalObjectsNotDestroyedCount:integer;
  FTotalTwiceDestroyedObjectsCount:integer;
public
  procedure StartSection;
  procedure FinishSection;
  procedure ObjectCreated(obj:tsafeobject);
  procedure ObjectDestroyed(obj:tsafeobject);
  constructor Create(repfilename:tfilename);
  procedure FinalizeReport;
  procedure WriteReportToFile;
  destructor Destroy; override;
end;

var
ProjectGarbageCollector:TGarbageCollector;

implementation

{ TSafeObject }

constructor TSafeObject.Create;
begin
  inherited;
  if GarbageCollectorActive then begin
    ProjectGarbageCollector.ObjectCreated(self);
  end;
end;

destructor TSafeObject.Destroy;
begin
  if GarbageCollectorActive then ProjectGarbageCollector.ObjectDestroyed(self);
  inherited;
end;

{ TGarbageCollector }

constructor TGarbageCollector.Create(repfilename:tfilename);
begin
  fobjects:=tlist.Create;
  FObjectsSaved:=tlist.Create;
  freport:=tstringlist.Create;
  if RepFileName='' then RepFileName:=extractfilepath(application.ExeName)+'garbreport.txt';

  FSaveRepFileName:=repfilename;
end;

destructor TGarbageCollector.Destroy;
begin
  if GarbageCollectorActive then begin
    WriteReportToFile;
  end;
  fobjects.Free;
  FObjectsSaved.Free;
  FReport.Free;
  inherited;
end;

procedure TGarbageCollector.FinalizeReport;
begin
  if FSectionStarted then freport.Add('Started section not ended!');
  freport.Add('Total:');
  freport.Add(inttostr(FSectionsCount)+' sections.');
  freport.Add(inttostr(FTotalObjectsNotDestroyedCount)+' objects not destroyed.');
  freport.Add(inttostr(FTotalTwiceDestroyedObjectsCount)+' objects destroyed twice.');
end;

procedure TGarbageCollector.FinishSection;
var
  q:integer;
  curstr:string;
  curobject:tobject;
  curoldnum:integer;
begin
  if not FSectionStarted then assert(false,'Section must have been already started.');

  curstr:='section finished: '+inttostr(FObjects.Count)+' objects remaining';
  if fobjects.Count>0 then curstr:=curstr+':' else curstr:=curstr+'.';
  freport.Add(curstr);

  curstr:=inttostr(FTwiceDestroyedObjectsCount)+' objects which were possibly destroyed twice were found.';
  freport.Add(curstr);

  for q:=0 to min(FObjects.Count-1,100) do begin
    curobject:=fobjects[q];
    curoldnum:=FObjectsSaved.IndexOf(curobject);
    curstr:=inttostr(curoldnum)+': '+curobject.ClassName;
    freport.Add(curstr);
  end;

  FTotalObjectsNotDestroyedCount:=FTotalObjectsNotDestroyedCount+fobjects.Count;
  FTotalTwiceDestroyedObjectsCount:=FTotalTwiceDestroyedObjectsCount+FTwiceDestroyedObjectsCount;

  FSectionStarted:=false;
end;

procedure TGarbageCollector.ObjectCreated(obj: tsafeobject);
begin
  FObjects.Add(obj);
  fobjectssaved.Add(obj);
end;

procedure TGarbageCollector.ObjectDestroyed(obj: tsafeobject);
var
  objnum:integer;
begin
  objnum:=fobjects.IndexOfItem(obj,fromend);
  if objnum=-1 then begin
  inc(FTwiceDestroyedObjectsCount); exit;
end;
  FObjects.Delete(objnum);
end;

procedure TGarbageCollector.StartSection;
begin
  if FSectionStarted then assert(false,'Section must have not been already started.');

  inc(fsectionscount);

  freport.Add('Section N'+inttostr(fsectionscount)+' started.');
  FObjects.clear;
  FObjectsSaved.Clear;
  FSectionStarted:=true;
  FTwiceDestroyedObjectsCount:=0;
end;

procedure TGarbageCollector.WriteReportToFile;
begin
  FinalizeReport;
  freport.SaveToFile(FSaveRepFileName);
end;

initialization
begin
  ProjectGarbageCollector:=TGarbageCollector.Create('');
end;

finalization
begin
  ProjectGarbageCollector.Free;
end;

end.