Speicherleck bei verschachtelten Objekten

[LeoDD]

Hallo liebe Delphi Gurus, wieder einmal verzweifel ich obwohl die Lösung sicher ganz nah ist.

Ich verwende mehrere Listen (TObjectList) und Ableitungen von TObjectList.

Das sieht zum Beispiel so aus:

Delphi-Quellcode:

TTC7AutoStart = class(TObjectList)

    public
      IconCache: TTC7IconCache;
      Statistic: TTC7AutoStartStatistic;
      AutostartLocations: TObjectList;

Hier noch die Deklarationen von Iconcache:

TTC7IconCache = class(TObjectList) Statistic ist ein einfacher Record.

Seit kurzem verwende ich EurekaLog um Speicherlecks zu finden. Mit Hilfe dieses Tools konnte ich bereits einige Speicherleichen beseitigen. Aber bei den TObjectLists bzw. den Ableitungen bekomme ich graue Haare.

Ich instanziiere TTC7Autostart im OnCreate Ereignis des Hauptformulars:

Delphi-Quellcode:

procedure TASManForm.FormCreate(Sender: TObject);
{
  CREATE
}
begin

  ...

  Autostarts := TTC7AutoStart.Create;
  IconUnknown:= TIcon.Create;

Im OnDestroy Ereignis will ich alles Erzeugte dann wieder freigeben:

Delphi-Quellcode:

procedure TASManForm.FormDestroy(Sender: TObject);
begin
  Autostarts.Free;
  IconUnknown.Free;
end;

Ich bekomme allerdings jedesmal eine Zugriffsverletzung bei der Freigabe der Autostarts. Laut CPU Ansicht ist das Objekt gar nicht mehr vorhanden, es scheint an anderer Stelle bereits freigegeben zu sein. Ich habe jedoch keine manuelle Freigabe vorher vorgenommen.

Wie gehe ich mit den TObjectLists in einer Ableitung von TObjectList um? Wo muss diese freigegeben werden?

Ebenso zeigt mir Eurekalog auch für das IconUnknown ein Speicherleck an, obwohl ich es doch in OnDestroy wieder freigebe.

Habe ich einen Denkfehler? Sollte ich solche Form-globalen Objekte anders instanziieren und verwenden?

[mjustin]

Zitat von LeoDD:

Ich bekomme allerdings jedesmal eine Zugriffsverletzung bei der Freigabe der Autostarts. Laut CPU Ansicht ist das Objekt gar nicht mehr vorhanden, es scheint an anderer Stelle bereits freigegeben zu sein. Ich habe jedoch keine manuelle Freigabe vorher vorgenommen.

TObjectList.OwnsObjects ist defaultmäßig true. Daher werden beim Free einer Instanz auch alle Listeneinträge freigegeben. War's das eventuell?

Viele Grüße

[LeoDD]

Leider nicht. Ich bin jetzt schon etwas weitergekommen, das ist vielleicht für andere auch gut zu wissen, die sich mit ähnlichen Problemen herumschlagen.

Eine TObjectList, deren Objekte selbst Objekte beinhalten, gibt diese verschachtelten Objekte nicht wieder frei, wenn diese manuell instanziiert werden.

Beispiel:

TObjectList1 beinhaltet Zeiger auf Records, in dem ein Objekt vom Typ TIcon vorkommt. Wird das TIcon des Records instanziiert, muss es später (z.B. beim Destroy) manuell freigegeben werden mit Free. Das letztendliche Dispose kann man sich sparen, da das die Liste dann selbst übernimmt.

Hier nochmal eine Klarstellung von meinem Problem:

EurekaLog meckert über Speicherlecks in diesem Codeabschnitt:

Delphi-Quellcode:

constructor TTC7AutoStart.Create;
begin

  inherited;

  if not InitAll then Halt;
  
  WinDir := GetWindowsDir;
  SysDir := GetSystemDir;
  WinDrive := GetWindowsDrive;
  ActualUser := GetActualUser;

  ASSnapshotDir := GetSnapshotDir;

  IconCache := TTC7IconCache.Create;
  AutostartLocations := TObjectList.Create; //<- Speicherleck
  Encyclopedia := TTC7Encyclopedia.Create; //<- Speicherleck

  Self.Win64Bit := IsWow64;

end;

In meinem Destructor sieht es so aus:

Delphi-Quellcode:

destructor TTC7Autostart.Destroy;
begin

  IconCache.Free; //Objektinstanzen freigeben von TIcon
//  AutostartLocations.Free; //<- wenn das aktiv ist, gibts eine Schutzverletzung bei Programmende
//  Encyclopedia.Free; //<- wenn das aktiv ist, gibts eine Schutzverletzung bei Programmende

end;

Irgendwo muss ich doch die beiden Objekte freigeben

[franktron]

Muss das nicht so sein

Delphi-Quellcode:

destructor TTC7Autostart.Destroy;
begin
  Encyclopedia.Free;
  AutostartLocations.Free;
  IconCache.Free; //Objektinstanzen freigeben von TIcon
end;

[LeoDD]

Hab ich gerade versucht, hat aber nichts geholfen. Schutzverletzung bei Encyclopedia.Free.

[SirThornberry]

Zitat:

TObjectList1 beinhaltet Zeiger auf Records...

Direkt in der Objectliste? Hast du es so eingestellt das diese Objectliste ihre Items nicht frei gibt (also kein ownObjects). Hast du diese Records dort per Caste rein gepackt?
Um ehrlich zu sein bringt mich dein geposteter Source auf der Suche nach dem Fehler nicht weiter.

[LeoDD]

Hier mal der Source von TTC7Encyclopedia:

Delphi-Quellcode:

{
  Klasse für die Arbeit mit der Enzyklopädie
}
unit tc7_class_encyclopedia;

interface

uses
  Classes, SysUtils, xmldom, XMLDoc, XMLIntf, Dialogs, Contnrs,

  //eigene Units
  tc7_functions_common,
  xmlcomm_class_encyclopedia;


type

  TTC7EncyclopediaDataStruc = record

    //die ID, die als Haupt-Prüfkriterium gilt
    PrimaryID: string;
    //weitere IDs, für die dieser Eintrag gilt (kommaseparierte Liste)
    SecondIDList: string;
    //Titel des Eintrages
    Caption: string;
    //Teaser, kurze Beschreibung
    Teaser: string;
    //die Beschreibung des Eintrages
    Description: string;
    //Datum der Erfassung des Eintrages
    CreateDate: string;
    //Gefahrenlevel (0=grün, 1=unbekannt, 2=rot)
    DangerLevel: byte;
    //Kann gelöscht werden? Oder evtl. für Betrieb nötig?
    //(0=ja, 1=nachfragen, 2=nein)
    CanRemoved: byte;
    //Dateiname des Eintrages (XML Datei, woraus der Eintrag stammt)
    EncyclopediaFile: string;

  end;

  PTTC7EncyclopediaDataStruc = ^TTC7EncyclopediaDataStruc;

  TTC7Encyclopedia = class;


  {
    class TC7Encyclopedia
  }
  TTC7Encyclopedia = class(TObjectList)

    public
      constructor Create;

      function ReadEncyclopedia(EncyclopediaDirectory: string): integer;
      function GetInfo(UniqueID: shortstring; var InfoStruc: TTC7EncyclopediaDataStruc): boolean;

    private

    protected

  end;


implementation


constructor TTC7Encyclopedia.Create;
begin

  inherited Create;

end;


{
  Liest die Enzyklopädie von der Festplatte in die Liste.

  Gibt -1 zurück, wenn ein Fehler auftrat, ansonsten die Anzahl der Einträge
}
function TTC7Encyclopedia.ReadEncyclopedia(EncyclopediaDirectory: string): integer;
var
  SRec: TSearchRec;
  OK: integer;
  EncyclopediaEntry: IXMLTc7_encyclopediaType;
  EncyclopediaData: TTC7EncyclopediaDataStruc;
  PEncyclopediaData: PTTC7EncyclopediaDataStruc;
  i: integer;
  SecondaryList: TStringList;
begin

  Result := -1;

  //Einlesen der XML Dateien
  if DirectoryExists(EncyclopediaDirectory) then begin

    Result := 0;

    SecondaryList := TStringList.Create;

    OK := FindFirst(EncyclopediaDirectory + '*.xml', faAnyFile, SRec);
    while OK=0 do begin

      try
        EncyclopediaEntry := Loadtc7_encyclopedia(EncyclopediaDirectory + SRec.Name);
        with EncyclopediaData do begin
          PrimaryID := EncyclopediaEntry.Identification.Primary;
          SecondIDList := '';
          if EncyclopediaEntry.Identification.Secondary.Count>0 then begin
            for i:=0 to EncyclopediaEntry.Identification.Secondary.Count-1 do begin
              SecondaryList.Add(EncyclopediaEntry.Identification.Secondary.Id[i]);
            end;
            SecondIDList := SecondaryList.CommaText;
          end;
          Caption := StringRemoveTabs(Trim(EncyclopediaEntry.Caption));
          Teaser := StringRemoveTabs(Trim(EncyclopediaEntry.Teaser));
          Description := StringRemoveTabs(Trim(EncyclopediaEntry.Description));
          CreateDate := StringRemoveTabs(Trim(EncyclopediaEntry.CreateDate));
          DangerLevel := EncyclopediaEntry.Dangerlevel;
          CanRemoved := EncyclopediaEntry.Canremoved;
          EncyclopediaFile := SRec.Name;
        end;
        New(PEncyclopediaData);
        PEncyclopediaData^ := EncyclopediaData;
        
        Add(TObject(PEncyclopediaData));

        Inc(Result);
      except
        ShowMessage('Invalid encyclopedia file: "' + SRec.Name + '"');
      end;

      OK := FindNext(SRec);
    end;
    FindClose(SRec);

    SecondaryList.Free;

  end;
end;



{
  Holen der Info anhand einer UniqueID.
  Wird die ID gefunden, werden die Daten in der Struktur gespeichert und TRUE zurückgegeben.
  Wird die ID nicht gefunden, wird FALSE zurückgegeben.
}
function TTC7Encyclopedia.GetInfo(UniqueID: shortstring; var InfoStruc: TTC7EncyclopediaDataStruc): boolean;
var
  i: integer;
  Pointer: PTTC7EncyclopediaDataStruc;
  SecondaryList: TStringList;
begin

  Result := false;

  if Count>0 then begin
    //PrimaryIDs durchsuchen
    for i:=0 to Count-1 do begin
      Pointer := PTTC7EncyclopediaDataStruc(Items[i]);
      if UniqueID = Pointer^.PrimaryID then begin
        InfoStruc := Pointer^;
        Result := true;
      end;
    end;
    //SecondaryIDs durchsuchen
    if not Result then begin
      SecondaryList := TStringList.Create;
      for i:=0 to Count-1 do begin
        Pointer := PTTC7EncyclopediaDataStruc(Items[i]);
        SecondaryList.CommaText := Pointer^.SecondIDList;
        if SecondaryList.IndexOf(UniqueID)>-1 then begin
          InfoStruc := Pointer^;
          Result := true;
        end;
      end;
      SecondaryList.Free;
    end;
  end;

end;



{
  PRIVATE
}


end.

Hab ich irgendwo was übersehen oder sollte ich etwas anders lösen?

[Blup]

Add(TObject(PEncyclopediaData));

Das kann natürlich nicht gut gehen.
TObjectList verwaltet Instanzen von TObject oder deren Nachkommen aber keine Records.
Wenn die Objectliste ein Element freigeben will, wird die Methode Free dieses Elements aufgerufen
(und Sie versucht alle Elemente freizugeben, wenn Sie selbst freigegeben wird).

Einfachste Lösung statt einem Record TTC7EncyclopediaDataStruc eine Klasse deklarieren:

TTC7EncyclopediaData = class(TObject)
{.. Felder ..}
end;

EncyclopediaData := TTC7EncyclopediaData.Create;
{.. Feldwerte zuweisen ..}
Add(EncyclopediaData);

[LeoDD]

Das werde ich mal probieren, danke erstmal

[LeoDD]

Ich hab meine Datenstruktur nun auf classes umgestellt, die Speicherung klappt auch. Mir werden allerdings immer noch Speicherlecks angezeigt und vermutlich mache ich was falsch bei der Belegung der Listen.

Ich habe eine Routine, die eine neue Klasse anlegt damit diese später verwendet werden kann. Und dort findet EurekaLog ein Speicherleck:

Delphi-Quellcode:

procedure TTC7AutoStart.CreateAutoStartStruc(var AutoStartStruc: TTC7AutoStartStruc);
{
  Setzt die Daten eines AutoStartStruc auf definierte Anfangswerte.
}
var
  ASStruc: TTC7AutoStartStruc;
  EData: TTC7EncyclopediaData;
begin

  ASStruc := TTC7AutoStartStruc.Create; //<- Speicherleck
  EData := TTC7EncyclopediaData.Create; //<- Speicherleck

  with ASStruc do begin

    Index := -1;
    EntryType := asUndefined;
    AutoStartDangerLevel := dlMiddle;
    UniqueID := '';
    IconCacheIndex := -1;
    DeterminedFile := '';
    Status := stEnabled;
    HasEncyclopediaEntry := false;

    EncyclopediaInfo := EData;
    with EncyclopediaInfo do begin
      PrimaryID := '';
      SecondIDList := '';
      Caption := '';
      Teaser := '';
      Description := '';
      CreateDate := '';
      DangerLevel := 1; //entspricht dlMiddle
    end;

    with DeterminedFileInfo do begin
      CompanyName := '';
      FileDescription := '';
      FileVersion := '';
      InternalName := '';
      LegalCopyright := '';
      LegalTrademarks := '';
      OriginalFilename := '';
      ProductName := '';
      ProductVersion := '';
      Comments := '';
    end;

    with FileData do begin
      FileName := '';
      FileHash := '';
      FileAttr := -1;
      FileDate := 0;
      FileSize := -1;
      FileTextLineCount := -1;
    end;

    with RegData do begin
      MainKey := '';
      Path := '';
      Key := '';
      Value := '';
      ValueHash := '';
    end;

  end;

  AutoStartStruc := ASStruc;

//  EData.Free; //<- wenn ich das mache, crasht es
//  ASStruc.Free; //<- wenn ich das mache, crasht es

end;

Verwendet wird das dann so:

Delphi-Quellcode:

function TTC7AutoStart.NewAutostartFiles(ASKind: TTC7AutoStartKind; Directory: string): integer;
var
  ASStruc: TTC7AutoStartStruc;
//  ASPointer: PTTC7AutoStartStruc;
  SRec: TSearchRec;
  OK: integer;
  Directory2: string;
begin
...
        CreateAutoStartStruc(ASStruc);

        ASStruc.Index := Self.Count;
        ASStruc.EntryType := ASKind;

        ASStruc.FileData.FileName := Directory2 + SRec.Name;
...
Self.Add(ASStruc);