Штуковина 1.0
От: Khimik  
Дата: 30.11.18 11:20
Оценка: -1
Предлагаю угадать, что делает (для чего нужен) этот код:


  Delphi
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.
Re: Штуковина 1.0
От: koenjihyakkei Россия  
Дата: 30.11.18 11:23
Оценка: +7 :))) :))
Здравствуйте, Khimik, Вы писали:

K>Предлагаю угадать, что делает (для чего нужен) этот код:


Плачет от тоски и безысходности от того, что написан на Делфи и никому не нужен
Re: Штуковина 1.0
От: Kernan Ниоткуда https://rsdn.ru/forum/flame.politics/
Дата: 30.11.18 14:03
Оценка:
Здравствуйте, Khimik, Вы писали:

K>Предлагаю угадать, что делает (для чего нужен) этот код:

Не пора ли переписать всё на C# как тебе советовали 4 года назад?
Sic luceat lux!
Re[2]: Штуковина 1.0
От: sergey2b ЮАР  
Дата: 30.11.18 14:05
Оценка:
Здравствуйте, Kernan, Вы писали:

K>Здравствуйте, Khimik, Вы писали:


K>>Предлагаю угадать, что делает (для чего нужен) этот код:

K>Не пора ли переписать всё на C# как тебе советовали 4 года назад?

как он защитит app от дизасемблирования
.NET придеться на PC клиента ставить
Re[2]: Штуковина 1.0
От: Khimik  
Дата: 30.11.18 14:31
Оценка:
Здравствуйте, Kernan, Вы писали:

K>Здравствуйте, Khimik, Вы писали:


K>>Предлагаю угадать, что делает (для чего нужен) этот код:

K>Не пора ли переписать всё на C# как тебе советовали 4 года назад?

А зачем переписывать если у меня есть Штуковина? Я уже один старый баг отловил, знаю что есть ещё какие-то...
Re: Штуковина 1.0
От: uncommon Марс  
Дата: 01.12.18 07:44
Оценка: +1
Здравствуйте, Khimik, Вы писали:

K>Предлагаю угадать, что делает (для чего нужен) этот код:


Оно?
Re: Штуковина 1.0
От: Dym On Россия  
Дата: 01.12.18 18:51
Оценка:
Здравствуйте, Khimik, Вы писали:

K>Предлагаю угадать, что делает (для чего нужен) этот код:

Ну, Штуковина 1.0 обычно делает всякую Хрень 1.0
Счастье — это Glück!
Re: Штуковина 1.0
От: swame  
Дата: 03.12.18 08:33
Оценка:
Здравствуйте, Khimik, Вы писали:

K>Предлагаю угадать, что делает (для чего нужен) этот код:


Изучи наконец FastMM FullDebugMode
Re[2]: Штуковина 1.0
От: Khimik  
Дата: 04.12.18 13:52
Оценка:
Здравствуйте, koenjihyakkei, Вы писали:

K>Здравствуйте, Khimik, Вы писали:


K>>Предлагаю угадать, что делает (для чего нужен) этот код:


K>Плачет от тоски и безысходности от того, что написан на Делфи и никому не нужен


Можно подумать, что на C++ аналогичный объект не напишешь...
Re: Штуковина 1.0
От: Khimik  
Дата: 15.12.18 08:30
Оценка:
Прошу помочь кого-нибудь, кто пользовался библиотекой JclDebug.
Мне нужно в конструкторе tsafeobject.create проанализировать стек, чтобы узнать, из какого участка кода был вызван этот конструктор. Я читал, что для этого в принципе можно использовать исключения: собственный обработчик исключений получает переменную e.StackTrace, в которой, как я понял, содержится много полезной информации. Но Embarcadero сознательно по каким-то причинам отключили эту возможность (если я правильно понимаю, это специфика именно Delphi — в .NET есть Exception.StackTrace и в Java есть Exception.getStackTrace).
Говорят, что Exception.StackTrace в Delphi заработает, если к проекту подключить библиотеку JclDebug. Я пробую это делать и пока конкретно запутался, в этой библиотеке слишком много ерунды которая мне не нужна. Может кто-нибудь подсказать, по какому принципу подключение JclDebug к проекту активирует Exception.StackTrace – просто какое-то объявление в заголовках, или код, выполняющийся при initialization одного из модулей JclDebug?
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.