Einzelnen Beitrag anzeigen

BAMatze

Registriert seit: 18. Aug 2008
Ort: Berlin
759 Beiträge
 
Turbo Delphi für Win32
 
#1

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

  Alt 31. Jul 2009, 10:13
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 <> 'RECYCLERthen 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
Miniaturansicht angehängter Grafiken
fehlerausgabe_158.png  
2. Account Sero
  Mit Zitat antworten Zitat