Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Problem Funktion, die als Rückgabe ein Objekt hat (https://www.delphipraxis.net/8520-problem-funktion-die-als-rueckgabe-ein-objekt-hat.html)

nailor 6. Sep 2003 20:16


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

sakura 6. Sep 2003 20:30

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:
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;
...:cat:...

nailor 6. Sep 2003 21:03

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:

nailor 6. Sep 2003 22:28

Re: Problem Funktion, die als Rückgabe ein Objekt hat
 
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 7. Sep 2003 00:16

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:
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 7. Sep 2003 11:09

Re: Problem Funktion, die als Rückgabe ein Objekt hat
 
Zitat:

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 7. Sep 2003 11:24

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:
Result.AddString(RootFolder);
ausgeführt.
Wenn ein gültiger Wert gefunden wird, wird
Delphi-Quellcode:
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
Delphi-Quellcode:
Result.AddString(RootFolder);
ein zweites Mal hinzugefügt wird.
Delphi-Quellcode:
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
Delphi-Quellcode:
SubList := TListOfStrings.Create(100);
durch
Delphi-Quellcode:
SubList := nil;
Initialisieren musst Du die Variable ja trotzdem.

nailor 7. Sep 2003 12:02

Re: Problem Funktion, die als Rückgabe ein Objekt hat
 
Nein, klappt nicht. Ich werde dann soch erstmal die Version mit dem Pointer probieren.

Christian Seehase 7. Sep 2003 12:48

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?

nailor 7. Sep 2003 12:57

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:
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 23:37 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz