[[FastMM] Free einer Klasse verhält sich unterschiedlich

[BAMatze]

Hallo und guten Tag an alle DP´ler,

Hab mal noch so eine Frage zu der Arbeit mit FastMM. Ich habe eine Klasse geschrieben, die ich für Suchen von Dateien in meinem Projekt benutze. Hier erstmal schnell der Quellcode:

Delphi-Quellcode:

unit DateiArbeit;

interface

uses Windows, SysUtils, Classes, Dialogs, FestplattenArbeit;

Type TDateiArbeit = class(TComponent)
  private
    FsDateiname: string;
    FRECYCLEROff: boolean; // sollen Funde im RECYCLER-Ordner mit ausgegeben werden
    FFestplatte: TFestplattenArbeit;
    // Der FtsPfad beinhaltet sämtliche Pfade, in der die entsprechende Datei
    // gefunden wurde. Sie kann nicht durch den Bediener geändert werden.
    FtsPfad: TStringList;
    FbDatei_vorhanden: boolean;
    function IsFileName: boolean;
    procedure FindAllFiles(var FileList: TStringList; RootFolder: string; Mask: string =
  '*.*'; Recurse: Boolean = True);
    function GetVorhanden: boolean;
    function GetLastModifiedFilePath: string;
  protected

  public
    constructor create(AOwner: TComponent; const sText: string; RECYCLEROff: boolean); reintroduce;
    destructor Destroy; override;
    property Vorhanden: boolean read GetVorhanden;
    property Dateipfad: TStringlist read FtsPfad;
    property LastModifiedDateiPfad: string read GetLastModifiedFilePath;
end;

implementation


{////////////////////////////////////////////////////////////////////////////////////}
{/                              create und destroys                                 /}
{////////////////////////////////////////////////////////////////////////////////////}

constructor TDateiArbeit.create(AOwner: TComponent; const sText: string; RECYCLEROff: boolean);
var Index: integer;
begin
  inherited create(AOwner);
  FFestplatte := TFestplattenArbeit.create(nil);
  FsDateiname := sText;
  FRECYCLEROff := RECYCLEROff;
  if IsFileName then
    begin
      FtsPfad := TStringList.Create;
      FindAllFiles(FtsPfad,'d:\',FsDateiname, true);
    end
  else Showmessage('Kein gültiger Dateiname übergeben!');
end;

destructor TDateiarbeit.destroy;
begin
  FFestplatte.Free;
  FtsPfad.Free;
  inherited destroy;
end;

{////////////////////////////////////////////////////////////////////////////////////}
{/                              private Funktionen                                  /}
{////////////////////////////////////////////////////////////////////////////////////}

function TDateiArbeit.GetLastModifiedFilePath: string;
var aktuellerFileHandle, neusterFileHandle: THandle;
    SysTimeStruct: SYSTEMTIME;
    createtime, accesstime, modifiedtime: TFiletime;
    LastModifiedTime, aktuelleModifiedTime: string;
    Index, Flag: integer;
begin
  if FtsPfad.Count < 1 then
    begin
      result := '';
    end
  else
    begin
      neusterFileHandle := FileOpen(FtsPfad[0], fmOpenRead or fmShareDenyNone);
      GetFileTime(neusterFileHandle, @createtime, @accesstime, @modifiedtime);
      if FileTimeToSystemTime(modifiedtime, SysTimeStruct) then
        LastModifiedTime := DateTimetoStr(SystemTimeToDateTime(SysTimeStruct) - 0);
      Flag := 0;
      for Index := 1 to FtsPfad.Count-1 do
        begin
          neusterFileHandle := FileOpen(FtsPfad[Index], fmOpenRead or fmShareDenyNone);
          GetFileTime(neusterFileHandle, @createtime, @accesstime, @modifiedtime);
          if FileTimeToSystemTime(modifiedtime, SysTimeStruct) then
            aktuelleModifiedTime := DateTimetoStr(SystemTimeToDateTime(SysTimeStruct) - 0);
          if aktuelleModifiedTime < LastModifiedTime then
            begin
              Flag := Index;
              LastModifiedTime := aktuelleModifiedTime;
            end;
        end;
      result := FtsPfad[Flag];
    end;

end;

function TDateiArbeit.GetVorhanden: boolean;
begin
  if (IsFileName) and (FtsPfad.Count > 0) then result := true
  else result := false;
end;

function TDateiArbeit.IsFileName: boolean;
const ForbiddenChars = ['"', '<', '>', '|', '*', '/', '\', '?']; // verbotene Zeichen

const ForbiddenNames: Array[0..22] of String[6] = ('AUX', 'NUL', 'PRN' ,'CON', 'CLOCK$',  // verbotene Namen
'COM1', 'COM2', 'COM3', 'COM4', 'COM5', 'COM6', 'COM7', 'COM8', 'COM9',
'LPT1', 'LPT2', 'LPT3', 'LPT4', 'LPT5', 'LPT6', 'LPT7', 'LPT8', 'LPT9');

var i: Integer;
var p: PChar;
var FileNameU: String;
begin
Result := False;

  if FsDateiname <> '' then // Name darf nicht leer sein
  begin
    i := Length(FsDateiname);

    if FsDateiname[i] <> '.' then // letze Zeichen darf kein Punkt sein
    begin
      p := Pointer(FsDateiname);
      repeat if p^ in ForbiddenChars then
        Exit;
        inc(p);
      until p^ = #0;

      if (i < 7) and (i > 2) then
      begin
        FileNameU := UpperCase(FsDateiname);
        for i := 0 to High(ForbiddenNames) do
        begin
          if CompareStr(ForbiddenNames[i], FileNameU) = 0 then
          Exit;
        end;
      end;
    Result := True;
  end;
  end;
end;

procedure TDateiArbeit.FindAllFiles(var FileList: TStringList; RootFolder: string; Mask: string = '*.*'; Recurse: Boolean = True);
var SR: TSearchRec;
    sTemp: string;
begin
  RootFolder := IncludeTrailingPathDelimiter(RootFolder);

  if Recurse then
    if FindFirst(RootFolder + '*.*', faAnyFile, SR) = 0 then
    try
      repeat
        if SR.Attr and faDirectory = faDirectory then
          if (SR.Name <> '.') and (SR.Name <> '..') then
            FindAllFiles(FileList, RootFolder + SR.Name, Mask, Recurse);
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  if FindFirst(RootFolder + Mask, faAnyFile, SR) = 0 then
  try
    repeat
      if SR.Attr and faDirectory <> faDirectory then
      begin
        if FRECYCLEROff then
          begin
            sTemp := RootFolder;
            delete(sTemp,1,3);
            delete(sTemp,9,Length(sTemp)-8);
            if stemp <> 'RECYCLER' then FileList.Add(RootFolder + SR.Name);
          end
        else FileList.Add(RootFolder + SR.Name);
      end;
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;
end;

end.

Alles nix Neues, im Endeffekt nur eine Zusammenstellung von Prozeduren, die ich hier gefunden hab. Jetzt habe ich ja aber gelernt, dass wenn ich Objekte erschaffe (Speicher allociere) ich diesen ja auch wieder freigeben muss. Jetzt habe ich 2 unterschiedliche Verhalten dieser Klasse beobachtet und frage mich warum dies der Fall ist.

1. Fall (mein Referenzprojekt, mit dem ich die Speicherlecks der Klasse erstmal feststellen wollte, da dies in einem großen Projekt ja immer ziemlich schwer ist (in meinem Fall musste ich 105 Speicherlecks finden in ca 10 Units und 3 Komponenten))

Delphi-Quellcode:

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //DateiArbeit1.Free; // trotz fehlendem Free erscheint kein Speicherleck
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DateiArbeit1 := TDateiArbeit.create(Self, 'Sensordatenbank.xls', true);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Memo1.Clear;
  if DateiArbeit1.Vorhanden then
    begin
      Memo1.Lines := DateiArbeit1.Dateipfad;
      Label1.Caption := DateiArbeit1.LastModifiedDateiPfad;
    end;
end;

Hier stellt sich mir die Frage, warum erscheint kein Speicherleck durch FastMM? Eigentlich (so dachte ich) müsste FastMM mindestens die 2 noch offenen TStringList (im destroy der TDateiArbeit) bemängeln.

Im 2. Fall (werde erstmal keinen Quellcode posten, da es sich hier um das eigentliche Projekt handelt und doch einige Zeilen an Quellcode vorhanden sind) führt hingegen das Free der TDateiArbeit zu einem größeren Fehler in FastMM siehe Bild im Anhang mit EAccessValuation. Ohne Free schließt das Programm korrekt und gibt wie gewohnt ein Fenster mit ein paar Speicherlecks aus.

Ich weiß gerade der 2. Fall ist erstmal schwieriger mir zu helfen, aber ich denke, wenn ich verstehe, warum der 1. Fall zustande kommt, sollte vieleicht auch der 2. Fall lösbarer werden.

Vielen Dank
BAMatze

[DeddyH]

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  DateiArbeit1 := TDateiArbeit.create(nil, 'Sensordatenbank.xls', true);
end;

Das dürfte ein Speicherleck geben, da hier im Gegensatz zu Deinem Code kein Owner angegeben wurde, welcher sich um die Freigabe kümmert.

[edit] Zum 2. Fehler:

Zitat:

Delphi-Quellcode:

Memo1.Lines := DateiArbeit1.Dateipfad;

Ändere das mal in

Delphi-Quellcode:

Memo1.Lines.Assign(DateiArbeit1.Dateipfad);

So wie oben setzt Du die Instanz von Memo1.Lines auf Dateipfad, kannst somit die eigentlichen Memo1.Lines nicht mehr freigeben. Dies versucht das Memo aber in seinem Destruktor, die Instanz ist nicht nil, aber auch nicht mehr gültig, und dann knallt es. [/edit]

[hoika]

Hallo,

im Fall2 gibst du die Klasse selber frei,
setzt sie wohl nicht auf NIL.
Dann versucht der Owner der Klasse (ein Form ?)
sie noch mal freizugeben.
Das schlägt fehl -> Schutzverletzung.


Heiko

[BAMatze]

Also erstmal schonmal Danke @hoika und @DeddyH. Der erste Fehler ist 100% korrigiert, bei dem 2. gibt es noch kleine Schwierigkeiten. Habe auf jeden Fall das Memo mal rausgeschmissen, war nur eine Kontrolle für der Dateisuche (also ob er wirklich den RECYCLER jetzt entfernt).

Hier mal der Umgesetzte Quellcode meines Projektes mit allen Stellen, wo die TDateiArbeit-Klasse verwendet wird.

Delphi-Quellcode:

type TDatenbankoberflaeche = class(TWinControl)
  private
    ...
    FsLPfade: TStringList;
    FsDatenbankPfad: string;
    FDatenbankDatei: TDateiArbeit;
    ...
    function GetArbeitsPfad: string;

  public
    constructor create(AOwner: TComponent); override;
    destructor Destroy; override;
    // das direkte Zugreifen auf die TStringlisten soll noch mit gettern ersetzt werden
    property Arbeitspfad: string read FsDatenbankPfad;
    property Dateipfade: TStringList read FsLPfade;
end;

{$R Zeichnung.RES}

implementation

constructor TDatenbankoberflaeche.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  Controlstyle := Controlstyle - [csAcceptsControls];
  Visible := true;
  Width := 600;
  Height := 400;
  FsLPfade := TStringList.Create;
end;

Destructor TDatenbankoberflaeche.Destroy;
begin
  try
    if Enabled then
      begin
        if not (csDesigning in Self.ComponentState) then 
          begin
            FExcelWorkbook.Close(true); // Speichert die Änderungen in Excel
            FExcelWorksheet.Free;
            FExcelWorkbook.Free;
            FExcelApplication.Free;
          end;
      end;
  finally
    FDatenbankDatei.Free;  // freigeben der TDateiArbeit-Klasse;
    FsLPfade.Free;
    ...
    inherited Destroy;
  end;
end;

function TDatenBankoberflaeche.GetArbeitsPfad: string;
var Index: integer;
    sparentroot, sTemp: string;
begin
  result := '';
  sparentroot := ExtractFilePath(ParamStr(0));
  for Index := 0 to FsLPfade.Count-1 do
    begin
      sTemp := FsLPfade[Index];
      delete(sTemp,Length(sTemp)-Length(ExcelDatenbankName)+1,Length(ExcelDatenbankName));
      if sparentroot = stemp then
        begin
          result := sTemp;
          break;
        end;
    end;
  if result = '' then
    begin
      sTemp := FDatenbankDatei.LastModifiedDateiPfad;
      delete(sTemp,Length(sTemp)-Length(ExcelDatenbankName)+1,Length(ExcelDatenbankName));
      result := sTemp;
    end;
  if result = '' then
    begin
      sTemp := FsLPfade[0];
      delete(sTemp,Length(sTemp)-Length(ExcelDatenbankName)+1,Length(ExcelDatenbankName));
      result :=  sTemp;
    end;
end;

procedure TDatenbankoberflaeche.CreateWnd;
begin
  screen.Cursor := crHourglass;
  inherited createwnd;
  ...
  if not (csDesigning in Self.ComponentState) then
    begin
      FDatenbankDatei := TDateiArbeit.create(nil, ExcelDatenbankName, true); // erstellen der TDateiArbeit-Komponente gändert mit nil
      FsLPfade := FDatenbankDatei.Dateipfad;
      if Verfuegbarkeit then
        begin
          Enabled := true;
          FsDatenbankPfad := GetArbeitspfad; // hier ist eigentlich der letzte Zugriff auf die TDateiArbeit-Komponente
        end
      else
        begin
          if not ExcelVerfuegbarkeit then
            begin
              MessageBox(Self.Handle, 'Sie haben keine oder eine falsche Version Office auf dem Rechner installiert. Bitte verwenden sie MS Office 2003, damit eine fehlerfreie Verwendung der Datenbank gewährleistet ist.',
                                                              'MS Excel 2003 nicht gefunden', MB_OK);
              Enabled := false;
            end
          else if not DateiVerfuegbarkeit then
            begin
              ExcelDatenbank_anlegen;
              Enabled := true;
            end;
        end;
      Initialisieren;
    end;
  ...
end;

end.

Es scheint wirklich, wie ihr sagt an der "Zuständigkeit/ dem Owner" zu liegen. Wenn ich das Free in der Destroy-Prozedur weg nehme ist der Fehler beseitigt. Aber eigentlich habe ich doch, wie jetzt den Owner schon mit dem Nil beseitigt, oder übersehe ich da schonwieder etwas?

[DeddyH]

Entweder beide Klassen verwenden eine eigene Instanz von TStringlist, dann musst Du sie Assign zuweisen. Oder eine Klasse legt die Instanz an und die andere erhält nur die Referenz darauf, dann musst Du zuweisen. Im Moment mischst Du beides, das geht nicht gut.

Zitat:

Delphi-Quellcode:

FsLPfade := FDatenbankDatei.Dateipfad; //wenn ich das richtig gesehen habe, sind das eigentlich 2 Instanzen

[edit] Nochmal 2 Beispiele zur Verdeutlichung:

Delphi-Quellcode:

type
  TTest = class
  strict private
    FList: TStrings;
  public
    constructor Create;
    destructor Destroy; override;
    property List: TStrings read FList write FList;
  end;

{ TTest }

constructor TTest.Create;
begin
  inherited;
  FList := TStringlist.Create;
end;

destructor TTest.Destroy;
begin
  FList.Free;
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
var Test1, Test2: TTest;
begin
  Test1 := TTest.Create;
  try
    Test2 := TTest.Create;
    try
      //die folgende Zeile verursacht Fehler:
      Test1.List := Test2.List;
      //diese aber nicht (alternativ zur obigen):
      Test1.List.Assign(Test2.List);
    finally
      Test2.Free;
    end;
  finally
    Test1.Free;
  end;
end;

Beide Objekte enthalten eine eigene TStrings-Instanz, daher muss mit Assign zugewiesen werden. Anders wäre es so (2 unterschiedliche Klassen):

Delphi-Quellcode:

type
  TTest = class
  strict private
    FList: TStrings;
  public
    constructor Create;
    destructor Destroy; override;
    property List: TStrings read FList write FList;
  end;

  TBla = class
  strict private
    FList: TStrings;
  public
    property List: TStrings read FList write FList;
  end;

{ TTest }

constructor TTest.Create;
begin
  inherited;
  FList := TStringlist.Create;
end;

destructor TTest.Destroy;
begin
  FList.Free;
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
var Test1: TTest;
    Bla: TBla;
begin
  Test1 := TTest.Create;
  try
    Bla := TBla.Create;
    try
      //Bla hat keine eigene Instanz erstellt, Zuweisung ist in Ordnung
      Bla.List := Test1.List;
      //dafür kracht es dann so:
      Bla.List.Free;
      //es sei denn, man gibt Bescheid:
      Bla.List := nil;
      Test1.List := Bla.List;
    finally
      Bla.Free;
    end;
  finally
    Test1.Free;
  end;
end;

So wie im 2. Beispiel sollte man das aber lieber nicht machen. Das Objekt, das eine Instanz anlegt, sollte auch für die Freigabe zuständig sein, sonst verliert man schnell den Überblick, was zu Speicherlecks und Zugriffsfehlern führt. [/edit]

[BAMatze]

:dp: Danke dir für die ausführlich Erklärung. Die war auch nötig, sonst hätte ich jetzt fragen müssen. Werde das so umbauen, wie du es geschrieben hast.

[Edit]
Die Änderung der Zeile allein gemäß DeddyH, hat schon fast sämtliche Fehler revidiert:

Delphi-Quellcode:

  // vorher
  FsLPfade := FDatenbankDatei.Dateipfad;
  // nachher
  FsLPfade.Assign(FDatenbankDatei.Dateipfad);

nur noch ein Fehler TServerEventDispatch wird noch gelistet.
[/Edit]