![]() |
Problem Funktion, die als Rückgabe ein Objekt hat
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 |
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Hm, ohne Code ist es schwer nachzuvollziehen, was genau Du verbrochen hast :mrgreen: Deshalb anbei mal ein Beispiel mit eine TStringList...
Delphi-Quellcode:
...:cat:...
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; |
Re: Problem Funktion, die als Rückgabe ein Objekt hat
werde mal testen, das auf meinen code zu portieren. melde mich bei misserfolg
...sollte es klappen, sag ichs auch :mrgreen: |
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Jetzt sieht der Code wie folgt aus:
Delphi-Quellcode:
RAM vorher 2,2 MB
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 nachher 15 MB irgendwo ist da noch ein Fehler, den ich nicht finde... |
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Moin Nailor,
das kannst Du einfacher haben, indem Du TListOfStrings nicht als Result einer Funktion übernimmst, sondern als Parameter.
Code:
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.
procedure TForm1.FindAllFiles2([b]AlosResult : TListOfStrings[/b]; RootFolder: string; Mask: string = '*.*'; Recurse: Boolean = True);
|
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Zitat:
|
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Moin Nailor,
ich hab' übrigens gerade einen Fehler in Deinem Source gefunden. Zu Beginn von FindAllFiles2 wird
Delphi-Quellcode:
ausgeführt.
Result.AddString(RootFolder);
Wenn ein gültiger Wert gefunden wird, wird
Delphi-Quellcode:
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 + SR.Name);
Delphi-Quellcode:
ein zweites Mal hinzugefügt wird.
Result.AddString(RootFolder);
Delphi-Quellcode:
darf also nur ausgeführt werden, wenn SR.Name kein Verzeichnis ist.
Result.AddString(RootFolder + SR.Name);
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
Delphi-Quellcode:
durch
SubList := TListOfStrings.Create(100);
Delphi-Quellcode:
Initialisieren musst Du die Variable ja trotzdem.
SubList := nil;
|
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Nein, klappt nicht. Ich werde dann soch erstmal die Version mit dem Pointer probieren.
|
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Moin Nailor,
das das Result schon ein Pointer ist, nämlich auf ein Objekt von Typ TListOfStrings, ist aber schon klar? |
Re: Problem Funktion, die als Rückgabe ein Objekt hat
Ja, ist es. Aber ich habe es jetzt mit der der Pointer als Parameter-Version gemacht:
Delphi-Quellcode:
Das funktioniert soweit auch.
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; |
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:26 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz