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;
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.');
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 7
Вы не можете начинать темы Вы не можете отвечать на сообщения Вы не можете редактировать свои сообщения Вы не можете удалять свои сообщения Вы не можете добавлять вложения