Штуковина 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...
Пока на собственное сообщение не было ответов, его можно удалить.