"Пролечить" утечки памяти. TobjectList & Tobject.Хранение обьектов...

[Человек_Борща]

Доброго времени суток!

Имеется некоторый класс реализованный над TObjectList и TOBject'ах.

Но подключив EurekaLog я ужыснулся от того, сколько памяти утекает.

Подозреваю, что дело в том, как я храню эти TObject в TObjectList.
Я просто:

var
 Obj:Tobject;
begin
//создаю обьект
  Obj:=TObjectList.create;
//добовляю его в список
  Add(Obj); //add взято от TObjectList
end;

Выкладываю модуль...

unit VisibleLogUnit;

interface

uses
  SysUtils,
  Classes,
  ComCtrls,
  MainUnit,
  MiscUnit,
  GlobalStrings,
  SyncObjs,
  sListView, sPageControl,Contnrs;

const
  etWait = 0;
  etStart = 1;
  etStop = 2;
  etRestart = 3;
  etError = 4;
  etMessage = 5;
  etUnknown = -1;

  sbAll = 0;
  sbWait = 1;
  sbStart = 2;
  sbStop = 3;
  sbRestart = 4;
  sbError = 5;
  sbMessage = 6;
  sbUnknown = 7;

type
  TLogRecord = class(TObject)
  public
    LogType: Smallint;
    LogMessage: string;
    RecordTime: string;
    function TypeAsText: string;
  end;

type
  TVisibleLog = class(TObjectList)
  private
    fCS: TCriticalSection;
    fTS: TStringList;
    fListView: TsListView;
    fEnabled: Boolean;
    fSortIndex: SmallInt;
    function GetRecord(indx: integer): TLogRecord;
    procedure TextToRecord(aText: string);
    procedure SetEnabled(Value: Boolean);
    procedure SetSort(Value: SmallInt);
  public
    constructor Create;
    destructor destroy; override;
    property Enabled: Boolean read fEnabled write SetEnabled default True;
    property SortBy: SmallInt read fSortIndex write SetSort default sbAll;
    property records[index: integer]: TLogRecord read GetRecord;
    property ShowLogTo: TsListView read fListView write fListView;
    procedure AddRecord(aRecordData: TLogRecord; Creating: boolean);
    procedure ShowRecord(aRecData: TLogRecord);
    procedure DeleteRecord(aRIndx: integer);
    procedure AddMessage(aType: Smallint; aText: string);
    procedure ClearLogFile;
    procedure Save;
  end;

implementation

const
  LogFileName = 'DDMMYY.vl';
  LogRecordFormat = '%d|%s|%s|';
  LogDateFormat = '';

  { TVisibleLog }

procedure TVisibleLog.AddMessage(aType: Smallint; aText: string);
var
  LR: TLogRecord;
begin
  if fEnabled then
  begin
{
0004 Memory Leak: Type=TLogRecord; Total size=16; Count=1; 
005F16DA TheG.exe VisibleLogUnit.pas TVisibleLog  AddMessage 86 3	
}
    LR := TLogRecord.Create;
    lr.LogType := aType;
    lr.LogMessage := aText;
    lr.RecordTime := FormatDateTime('dd.mm.yy', Date) + ' - ' + FormatDateTime('hh:mm:ss', Time);
    AddRecord(LR, False);
  end;
end;

procedure TVisibleLog.AddRecord(aRecordData: TLogRecord; Creating: boolean);
var
  LI: TlistItem;
begin
  with fListView do
  begin
    items.BeginUpdate;
    Add(aREcordData);
    LI := Items.Add;
    case aRecordData.LogType of
      etWait: Li.Caption := RsetWait;
      etStart: Li.Caption := RsetStart;
      etStop: Li.Caption := RsetStop;
      etRestart: Li.Caption := RsetRestart;
      etError: Li.Caption := RsetError;
      etMessage: Li.Caption := RsEtMessage;
      etUnknown: Li.Caption := RsEtUnknown;
    end;
    Li.SubItems.Add(aRecordData.LogMessage);
    LI.SubItems.Add(aRecordData.RecordTime);
    SetSort(fSortIndex); //Вызываем ресортировку элементов...
    Items.EndUpdate;
  end;
  fCS.Enter;
  try
    if not Creating then
    begin
      fTS.Add(Format(LogRecordFormat, [aRecordData.LogType, aRecordData.LogMessage, aRecordData.RecordTime]));
      Save;
    end;
  finally
    fCS.Leave;
  end;
end;

procedure TVisibleLog.ClearLogFile;
begin
  fListView.Items.Clear;
  Clear;
  fTS.Clear;
  Save;
end;

constructor TVisibleLog.Create;
var
  i: integer;
begin
  fCS := TCriticalSection.Create;
  fTS := TStringList.Create;
  ShowLogTo := MainForm.LogView;
  if FileExists(GetLogsDir + FormatDateTime(LogFileName, Date)) then
  begin
    fTs.LoadFromFile(GetLogsDir + FormatDateTime(LogFileName, Date));
    for i := 0 to fTS.count - 1 do
    begin
      TextToRecord(fTs.Strings[i]);
    end;
  end;
end;

procedure TVisibleLog.DeleteRecord(aRIndx: integer);
begin
  records[aRindx].Free;
  Delete(aRIndx);
end;

destructor TVisibleLog.destroy;
begin
  FreeAndNil(fCS);
  FreeAndNil(fTS);
  inherited;
end;

function TVisibleLog.GetRecord(indx: integer): TLogRecord;
begin
  try
    Result := (Items[indx] as TLogRecord);
  except
    on E: Exception do
      AddMessage(etUnknown,'TVisibleLog.GetRecord[' + IntTOStr(Indx) + '] E class: ' + E.ClassName + ' E text: ' + E.Message);
  end;
end;

procedure TVisibleLog.Save;
begin
  fTs.SaveToFile(GetLogsDir + FormatDateTime(LogFileName, Date));
end;

Продолжение в во 2-ом сообщении...

[Человек_Борща]

procedure TVisibleLog.SetEnabled(Value: Boolean);
begin
  if Value then
  begin
    ShowLogTo.Enabled := True;
    if (ShowLogTo.GetParentComponent is TsTabSheet) then
    begin
      (ShowLogTo.GetParentComponent as TsTabSheet).Caption := 'Лог событий';
    end;
  end
  else
  begin
    ShowLogTo.Enabled := False;
    if (ShowLogTo.GetParentComponent is TsTabSheet) then
    begin
      (ShowLogTo.GetParentComponent as TsTabSheet).Caption := 'Лог событий(Отключён)';
    end;
  end;
  fEnabled := Value;
  SetSort(fSortIndex);
end;

procedure TVisibleLog.SetSort(Value: SmallInt);
var
  i: Integer;
begin
  ShowLogTo.Items.Clear;
  for i := 0 to Count - 1 do
  begin
    case Value of
      sbAll: ShowRecord(records[i]);

      sbWait:
        begin
          if records[i].LogType = etWait then
            ShowRecord(records[i]);
        end;

      sbStart:
        begin
          if records[i].LogType = etStart then
            ShowRecord(records[i]);
        end;

      sbStop:
        begin
          if records[i].LogType = etStop then
            ShowRecord(records[i]);
        end;

      sbRestart:
        begin
          if records[i].LogType = etRestart then
            ShowRecord(records[i]);
        end;

      sbError:
        begin
          if records[i].LogType = etError then
            ShowRecord(records[i]);
        end;

      sbMessage:
        begin
          if records[i].LogType = etMessage then
            ShowRecord(records[i]);
        end;

      sbUnknown:
        begin
          if records[i].LogType = etUnknown then
            ShowRecord(records[i]);
        end;

    end;
  end;
end;

procedure TVisibleLog.ShowRecord(aRecData: TLogRecord);
var
  LI: TlistItem;
begin
  with fListView do
  begin
    LI := Items.Add;
    case aRecData.LogType of
      etWait: Li.Caption := RsetWait;
      etStart: Li.Caption := RsetStart;
      etStop: Li.Caption := RsetStop;
      etRestart: Li.Caption := RsetRestart;
      etError: Li.Caption := RsetError;
      etMessage: Li.Caption := RsEtMessage;
      etUnknown: Li.Caption := RsEtUnknown;
    end;
    Li.SubItems.Add(aRecData.LogMessage);
    LI.SubItems.Add(aRecData.RecordTime);
  end;
end;

procedure TVisibleLog.TextToRecord(aText: string);
const
  Delim = '|';
var
  LR: TLogRecord;
  s: string;
  tS: string;
  i: Integer;
begin
  s := aText;
  if s = '' then
    exit;
  LR := TLogRecord.Create;
  tS := Trim(copy(s, 1, Pos(Delim, s) - 1));
  if Trim(ts) = '' then
  begin
    ts := '5';
  end;
  if TryStrToInt(tS, i) then //Проверяем, является ли строка числом
  begin
    LR.LogType := i; //выставляем тип
  end
  else
  begin
    LR.LogType := etUnknown;
    LR.LogMessage := Format(RsOnEtUnknownMsg, [aText]);
    LR.RecordTime := FormatDateTime('dd.mm.yy', Date) + ' - ' + FormatDateTime('hh:mm:ss', Time);
    Exit;
  end;
  System.Delete(s, 1, Pos(Delim, s));
  {
0003 Memory Leak: Type=Data; Total size=252; Count=9; 
0064D47C TheG.exe VisibleLogUnit.pas TVisibleLog	TextToRecord 317 28	
  }
  lr.LogMessage := copy(s, 1, Pos(Delim, s) - 1);
  System.Delete(s, 1, Pos(Delim, s));
  lr.RecordTime := copy(s, 1, Pos(Delim, s) - 1);
  AddRecord(LR, True);
end;

{ TLogRecord }

function TLogRecord.TypeAsText: string;
begin
  case LogType of
    -1: Result := RsEtUnknown;
    0: Result := RsEtWait;
    1: Result := RsetStart;
    2: Result := RsetStop;
    3: Result := RsetRestart;
    4: Result := RsetError;
    5: Result := RsEtMessage;
  end;
end;

end.

[Silver_S]

  begin
    LR.LogType := etUnknown;
    LR.LogMessage := Format(RsOnEtUnknownMsg, [aText]);
    LR.RecordTime := FormatDateTime('dd.mm.yy', Date) + ' - ' + FormatDateTime('hh:mm:ss', Time);
    Exit;
  end;

Здесь lr не уничтожается и просто теряется

[phomm]

Там не то что возможен выход с потерей лога, но и при нормальной работе нет никаких lr.free;
И здесь такая же вещь, даже удивительно, куда Вы, ТС, смотрите :

procedure TVisibleLog.AddMessage(aType: Smallint; aText: string);
var
  LR: TLogRecord;
begin
  if fEnabled then
  begin
{
0004 Memory Leak: Type=TLogRecord; Total size=16; Count=1; 
005F16DA TheG.exe VisibleLogUnit.pas TVisibleLog  AddMessage 86 3	
}
    LR := TLogRecord.Create;    lr.LogType := aType;
    lr.LogMessage := aText;
    lr.RecordTime := FormatDateTime('dd.mm.yy', Date) + ' - ' + FormatDateTime('hh:mm:ss', Time);
    AddRecord(LR, False);
  end;
end;

Каждому Create необходимо вызывать соответствующий free.

И ещё: куча констант и кейсов - не очень красиво, енумы или даже полиморфизм Вам помогут сделать код удобнее, имхо

[Человек_Борща]

какбэ каждый обьект 1 запись. Пока существует запись - Существует обьект. Об уничтожении обьектов заботиться ObjectList в котором они храняться.

Может я не правильно передаю на хранение?

phomm, можно подробнее про "дополение":

И ещё: куча констант и кейсов - не очень красиво, енумы или даже полиморфизм Вам помогут сделать код удобнее, имхо

?

[Silver_S]

проверьте свойство, отвечающее за автоуничтожение объектов при уничтожении листа. хотя по дефолту true, но, может, изменяете извне?
И повторюсь про мое предыдущее сообщение - ссылка на объект теряется до того, как она будет добавлена в список - вот вам утечка

[Человек_Борща]

хех в деструкторе ObjectList какбы уничтожает обьекты..
ошибка ещё здесь:

procedure TVisibleLog.AddMessage(aType: Smallint; aText: string);
var
  LR: TLogRecord;
begin
  if fEnabled then
  begin
    LR := TLogRecord.Create;
    lr.LogType := aType;
    lr.LogMessage := aText;
    lr.RecordTime := FormatDateTime('dd.mm.yy', Date) + ' - ' + FormatDateTime('hh:mm:ss', Time);
    AddRecord(LR, False);
  end;
end;

ссылку ведь добовляю.... всеравно утекает.

[Johnson]

constructor TVisibleLog.Create;
var
  i: integer;
begin
inherited;

И inherited в конец процедуры деструктора... Не забывайте это делать для ОбъектныхЛистов...
Конкретно сейчас не помню, но сталкивался с подобным... память текла сотнями метров... Спас вызов родительского конструктора. Именно там объявляется свойство, отвечающее за удаление неиспользуемых классов.

[Человек_Борща]

хаха, спасибо, этот класс больше не течёт.
В некоторых кодах, видел вызов:

inherited Create;

и подобные им. Есть ли разница?

Далее по теме:
17 дырок, непонятно из чего течёт.

Как понимать это?

+Leak: Type=TIntConst; Total size=48; Count=3  
0041F2F1TheG.exe classes.pas   RegisterIntegerConsts          2368[1] 
0048EFB5TheG.exe Graphics.pas  Initialization   6911[15]
00407526TheG.exe SysInit.pas   _InitExe         668[7]  
0065566BTheG.exe TheG.dpr      Initialization   119[0]  

+Leak: Type=Data; Total size=64; Count=4       
0042002ETheG.exe classes.pas      TList      SetCapacity      2928[5] 
0041FD70TheG.exe classes.pas      TList      Grow             2841[8] 
0041FB02TheG.exe classes.pas      TList      Add2754[3] 
00420689TheG.exe classes.pas      TThreadListAdd3115[5] 
0041F2FDTheG.exe classes.pas   RegisterIntegerConsts          2368[1] 
0048EFB5TheG.exe Graphics.pas  Initialization   6911[15]

+Leak: Type=TRegGroup; Total size=100; Count=1 
0041EC94TheG.exe classes.pas      TRegGroups StartGroup  2059[6] 
0041F13FTheG.exe classes.pas   StartClassGroup  2262[3] 
00496D04TheG.exe Dialogs.pas   Initialization   2261[2] 
00407526TheG.exe SysInit.pas   _InitExe         668[7]  
0065566BTheG.exe TheG.dpr      Initialization   119[0]  

+Leak: Type=Data; Total size=48; Count=1       
0042002ETheG.exe classes.pas TList SetCapacity 2928[5]
0041FD70TheG.exe classes.pas TList Grow 2841[8]
0041FB02TheG.exe classes.pas TList Add 2754[3]
0041E345TheG.exe classes.pas TRegGroup AddClass 1733[1]
0041EAECTheG.exe classes.pas TRegGroups GroupWith 1989[3]
0041F197TheG.exe classes.pas GroupDescendentsWith 2272[3]

+Leak: Type=TList; Total size=16; Count=1
0041F4FBTheG.exe classes.pas RegisterFindGlobalComponentProc 2461[2] 
00507E20TheG.exe Forms.pas Initialization 7683[3] 
00407526TheG.exe SysInit.pas _InitExe 668[7]  
0065566BTheG.exe TheG.dpr Initialization 119[0]  
7C90DCB8ntdll.dll ZwSetInformationThread   

+Leak: Type=TCriticalSection; Total size=28; Count=1
005FD749TheG.exe IdComponent.pas Initialization 172[1]
00407526TheG.exe SysInit.pas  _InitExe 668[7]
0065566BTheG.exe TheG.dpr Initialization  119[0]
7C90DCB8ntdll.dll ZwSetInformationThread

+Leak: Type=Data; Total size=16; Count=1
0040BECCTheG.exe sysutils.pas AllocMem 3382[1]
004FCF76TheG.exe Forms.pas TCustomFormCreate 2554[1]

+Leak: Type=Data; Total size=36; Count=2       
00405038TheG.exe
7C91045Dntdll.dll RtlReleasePebLock

Вот этот:

+Leak: Type=TAppThread; Total size=164; Count=1
00649A16TheG.exe AppsListUnit.pas TApp  Start 111[3]
0064AF45TheG.exe AppsListUnit.pas TAppsList  Start 313[7]
0065249ATheG.exe MainUnit.pas TMainForm  FormCreate 459[12]
004FD471TheG.exe Forms.pas TCustomFormDoCreate  2648[3]
004FD0E1TheG.exe Forms.pas TCustomFormAfterConstruction 2575[1]

Где:

procedure TApp.Start;
begin
  if (AppThr = nil) then
  begin
    {
    AppThr:TThread;  описана в секции Private у TApp.
    }
    AppThr := TAppThread.Create(True);
    AppThr.AppInfo := @AppInfo;
    AppThr.OnTerminate := DoThreadTerminate;
    AppThr.Resume;
    Timer.Interval := AppInfo.AutoRestart * 1000 * 60;
    Timer.Enabled := True;
    AddStartEventToLOG(AppThr.AppInfo.ListName);
  end;
end;

Ещё:

+Leak: Type=Data; Total size=20; Count=1
00405038TheG.exe            
0040D3FFTheG.exe madDisAsm.pas COpcodeFlags             
0062534DTheG.exe AppThreadUnit.pas TAppThread Execute 165[46] 
    
+Leak: Type=Data; Total size=34; Count=1
00405038TheG.exe            
00625370TheG.exe AppThreadUnit.pasTAppThread Execute 166[48]

Код:

      s := ExtractFilePath(AppInfo.FileExe); //165 строка
      s2 := '"' + AppInfo.FileExe + '" ' + AppInfo.RunParams; //166 строка
      prc := CreateProcess(
        PChar(AppInfo.FileExe), // LPCTSTR lpApplicationName,
        PChar(s2),
        nil,
        nil, 
        False, 
        GetPriority(AppInfo.CPUPriority),
        nil, 
        PChar(s), 
        SI,
        PInfo);

Need HELP!

[Человек_Борща]

Знающие люди, помогите!
Пост №9 данной темы!

З.Ы. забыл добавить, программа собирается на delphi 7 + Update 1