Problem Funktion, die als Rückgabe ein Objekt hat

[nailor]

Ich habe eine erweitete Suchfunktion, die (natürlich) rekursiv arbeitet. Als Ergebnis (Result-Wert) liefert sie eine selbst geschriebene Klasse TListOfStrings zurück. Die Funktion ruft sich selbst auf, und fügt die erhaltenen TListOfStrings zusammen. Das klappt auch. Nur krieg ich den Speicher nicht geräumt, da die Funktion die TListOfStrings ja nicht intern löschen darf, weil sie ja bis zuletzt als Result-Wert bleiben müssen, und nicht gefreet werden dürfen, damit als Egebnis "gemeldet" werden kann.

Irgendwie komm ich da nicht weiter. Wenn ich nicht irgendwas murksen möchte, so dass immer an eine per pointer angegebene TListOfStrings angehängt wird, sondern wirklich immer eine TListOfString als Rückgabewert dasein soll, hab ich keinen Plan, wie das gehen könnt.

Michael

[sakura]

Hm, ohne Code ist es schwer nachzuvollziehen, was genau Du verbrochen hast Deshalb anbei mal ein Beispiel mit eine TStringList...

Delphi-Quellcode:

function Find(WoDenn, WatDenn: String): TStringList;
var
  SubList: TStringList;
begin
  Result := TStringList.Create;
  // suche
  ....
  // rekursion
  SubList := Find(WoDenn, WatDenn);
  try
    // ergenisse zufügen
    Result.AddStrings(SubList);
  finally
    // nicht mehr benötigtes Objekt zerstören,
    // strings sind ja schon übernommen
    SubList.Free;
  end;
end;

......

[nailor]

werde mal testen, das auf meinen code zu portieren. melde mich bei misserfolg

...sollte es klappen, sag ichs auch

[nailor]

Jetzt sieht der Code wie folgt aus:

Delphi-Quellcode:

function TForm1.FindAllFiles2(RootFolder: string; Mask: string = '*.*'; Recurse: Boolean = True): TListOfStrings;
var 
  SR: TSearchRec;
  SubList: TListOfStrings; 
begin
Result := TListOfStrings.Create(100);
SubList := TListOfStrings.Create(100);

if AnsiLastChar(RootFolder)^ <> '\' then
  RootFolder := RootFolder + '\';

try
  Result.AddString(RootFolder);
  if FindFirst(RootFolder + Mask, faAnyFile, SR) = 0 then
    try
      repeat
        if (SR.Name <> '.') and (SR.Name <> '..') then
          begin
            Result.AddString(RootFolder + SR.Name);
            if (SR.Attr and faDirectory = faDirectory) then
                SubList := FindAllFiles2(RootFolder + SR.Name, Mask, Recurse);
          end;
      until
        FindNext(SR) <> 0;
      Result.AddListOfStrings(SubList);
    finally
      FindClose(SR);
    end;
finally
  SubList.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var a: cardinal; b: tListOfStrings; c: cardinal;
begin
c := 5;
a := gettickcount;
for c := 0 to c do
  begin
    b := FindAllFiles2('C:\');
    b.Free;
  end;
caption := inttostr(gettickcount - a);
end;

RAM vorher 2,2 MB
RAM nachher 15 MB

irgendwo ist da noch ein Fehler, den ich nicht finde...

[Christian Seehase]

Moin Nailor,

das kannst Du einfacher haben, indem Du TListOfStrings nicht als Result einer Funktion übernimmst, sondern als Parameter.

Code:

procedure TForm1.FindAllFiles2([b]AlosResult : TListOfStrings[/b]; RootFolder: string; Mask: string = '*.*'; Recurse: Boolean = True);

Dann kann aus der Funktion eine Prozedur werden (unwichtig), und Du erzeugst vor aufruf der Prozedur das Ergebnisobjekt, so dass Du eine bessere Kontrolle darüber hast.

[nailor]

Zitat von Nailor:

Irgendwie komm ich da nicht weiter. Wenn ich nicht irgendwas murksen möchte, so dass immer an eine per pointer angegebene TListOfStrings angehängt wird, sondern wirklich immer eine TListOfString als Rückgabewert dasein soll, hab ich keinen Plan, wie das gehen könnt.

Weiß ich. Aber es muss doch auch so gehen!

[Christian Seehase]

Moin Nailor,

ich hab' übrigens gerade einen Fehler in Deinem Source gefunden.

Zu Beginn von FindAllFiles2 wird
Result.AddString(RootFolder); ausgeführt.
Wenn ein gültiger Wert gefunden wird, wird
Result.AddString(RootFolder + SR.Name); und für den Fall, dass SR.Name ein Directory ist, wird FindAllFiles2 mit RootFolder + SR.Name als Rootfolder aufgerufen, wodurch dieses Verzeichnis mit
Result.AddString(RootFolder); ein zweites Mal hinzugefügt wird.
Result.AddString(RootFolder + SR.Name); darf also nur ausgeführt werden, wenn SR.Name kein Verzeichnis ist.

Der Fehler dürfte sein, dass Du zu Beginn der Funktion SubList erzeugst. Genau diese Erzeugte Liste löscht Du am Ende aber nicht, sondern die, die Dir durch den rekursiven Aufruf übergeben wird.
Ersetz mal
SubList := TListOfStrings.Create(100); durch
SubList := nil; Initialisieren musst Du die Variable ja trotzdem.

[nailor]

Nein, klappt nicht. Ich werde dann soch erstmal die Version mit dem Pointer probieren.

[Christian Seehase]

Moin Nailor,

das das Result schon ein Pointer ist, nämlich auf ein Objekt von Typ TListOfStrings, ist aber schon klar?

[nailor]

Ja, ist es. Aber ich habe es jetzt mit der der Pointer als Parameter-Version gemacht:

Delphi-Quellcode:

procedure TForm1.FindAllFiles3(AlreadyFound: TListOfStrings; RootFolder: string; Mask: string = '*.*'; Recurse: Boolean = True);
var 
  SR: TSearchRec;     
begin
if AnsiLastChar(RootFolder)^ <> '\' then
  RootFolder := RootFolder + '\';

if FindFirst(RootFolder + Mask, faAnyFile, SR) = 0 then
  try
    repeat
      if (SR.Name <> '.') and (SR.Name <> '..') then
        begin
          AlreadyFound.AddString(RootFolder + SR.Name);
          if (SR.Attr and faDirectory = faDirectory) then
            FindAllFiles3(AlreadyFound, RootFolder + SR.Name, Mask, Recurse);
        end;
    until
      FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tk: cardinal;
  LoS: tListOfStrings;
  count: cardinal;
  MaxTimes: cardinal;
  FolderName: string;
begin
tk := GetTickCount;
FolderName := Edit1.Text;
MaxTimes := 3;
for count := 0 to MaxTimes do
  begin
    LoS := TListOfStrings.Create(100);
    if AnsiLastChar(FolderName)^ = '\' then
      FolderName := copy(FolderName, 0, pred(length(FolderName))); //damit alles ohne '\' in der Liste steht
    //noch ein check, ob der String gültig ist
    LoS.AddString(FolderName);
    if FileGetAttr(FolderName) and faDirectory = faDirectory then
      FindAllFiles3(LoS, FolderName);
    LoS.TruncateArray;
    Caption := inttostr(LoS.GetLength);
    Form1.Update;
    LoS.Free;
  end;
Caption := Caption + '    ' + inttostr(GetTickCount - tk);
end;

Das funktioniert soweit auch.