AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

FindAllFiles - Iterative

Ein Thema von himitsu · begonnen am 1. Nov 2009 · letzter Beitrag vom 16. Dez 2011
Antwort Antwort
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
38.398 Beiträge
 
Delphi 10.4 Sydney
 
#1

FindAllFiles - Iterative

  Alt 1. Nov 2009, 13:09
Hab hier noch eine Iterative-Lösung von FindAllFiles

Wo man sie eventuell dazustopfen könnte?
k.A. sucht euch was aus ... gibt ja mehr genug CodeLib-Einträge dazu > FindAllFilesFindAllFiles

Ich würde es eventuell hier dazustopfen
http://www.delphipraxis.net/internal...ct.php?t=46035

Da SirThornberry seine Variante ebenfalls dadurch optimiert hat, indem nur einmal die Verzeichnisse durchsucht werden und der Namensvergleich selber vorgenommen wird.
(viele dieser Codes suchen ja doppelt > Verzeichnisse und Dateien getrennt)

Allerdings wird bei mir der die Maske etwas windowstypischer ausgewertet, so daß es keine Probleme mit mehreren Punkten im Dateinamen gibt.

Über den Callback läßt sich 'ne Art Fortschrittsanzeige basteln, wo man z.B. das aktuelle Verzeichnis anzeigen könnte.

Zum Maskenvergleich wurde MatchText aus Stringvergleich mit Wildcards verwendet.

Diese Version ist etwa genauso schnell, wie die Rekursive von SirThornberry
und natürlich etwas flotter, als die Restlichen, wo mehrmals gesucht wird.
- etwas mehr Speicher beim Memory Manager, wegen des Arrays
- dafür weniger Speicher im Stack
- einen bissl optimaler bei der Speicherverwaltung, da sich dieser nicht bei jedem Verzeichnissprung ändert

Delphi-Quellcode:
Type TFAFCallback = Procedure(Const Dir: String; Count: Integer);

Procedure FindAllFiles(SL: TStrings; Const Dir: String; Const Mask: String = '*.*';
    Recurse: Boolean = True; Clear: Boolean = True; Callback: TFAFCallback = nil);

  Var MaskN, MaskE: String;
    i: Integer;
    A: Array of Record
      SR: TSearchRec;
      Dir: String;
    End;

  Label NotFound;

  Begin
    SL.BeginUpdate;
    Try
      If Clear Then SL.Clear;
      MaskN := ChangeFileExt(Mask, '');
      MaskE := ExtractFileExt(Mask);
      If MaskE <> 'Then Delete(MaskE, 1, 1)
      Else If Mask = '*Then MaskE := '*';
      SetLength(A, 32);
      A[0].Dir := IncludeTrailingPathDelimiter(Dir);
      i := 0;
      Repeat
        If Assigned(Callback) Then Callback(A[i].Dir, SL.Count);
        If FindFirst(A[i].Dir + '*.*', faAnyFile, A[i].SR) = 0 Then Begin
          Repeat
            If (A[i].SR.Name <> '.') and (A[i].SR.Name <> '..') Then
              If A[i].SR.Attr and faDirectory = 0 Then Begin
                If MatchText(MaskN, ChangeFileExt(A[i].SR.Name, ''))
                    and MatchText(MaskE, Copy(ExtractFileExt(A[i].SR.Name), 2, 888)) Then
                  SL.Add(A[i].Dir + A[i].SR.Name);
              End Else If Recurse Then Begin
                Inc(i);
                If i > High(A) Then SetLength(A, (i + 32) and not 31);
                A[i].Dir := A[i - 1].Dir + A[i - 1].SR.Name + '\';
                Break;
              End;
            While (i >= 0) and (FindNext(A[i].SR) <> 0) do Begin
              FindClose(A[i].SR);
              NotFound:
              Dec(i);
            End;
          Until i < 0;
        End Else Goto NotFound;
      Until i <= 0;
    Finally
      SL.EndUpdate;
    End;
  End;
Das Ganze wurde auch noch in einer Unit verpackt
und zusätzlich um eine Version erweitert, welche komplett nur über einen Callback die Suchergebnisse liefert.
Außerdem wurde das Verhalten noch in einer Klasse gekapselt.

Delphi-Quellcode:
uses FindFiles;

procedure TForm1.Callback(const Filename: String; Count: Integer);
begin
  Memo2.Lines.Add(Filename);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  C: TFindAllFiles;
begin
  { normale Funktion, so wie oben gezeigt }
  //Memo2.Lines.Clear; //nicht nötig, da das von FindAllFiles erledigt wird
  FindAllFiles(Memo1.Lines, Edit1.Text, '*.*', True, True);
  Memo1.Lines.Add(Format('***** %d *****', [Memo1.Lines.Count]));

  { Ergebnisse via Callback-Prozedur }
  Memo2.Lines.Clear;
  i := FindAllFilesCallback(Callback , Edit1.Text, '*.*', True);
  Memo2.Lines.Add(Format('***** %d / %d *****', [i, Memo2.Lines.Count]));

  { über die Klasse }
  Memo3.Lines.Clear;
  C := TFindAllFiles.Create;
  try
    if C.Start(Edit1.Text, '*.*', True) then
      repeat
        Memo3.Lines.Add(C.Filename);
      until not C.Next;
    i := C.Count;
  finally
    C.Free;
  end;
  Memo3.Lines.Add(Format('***** %d / %d *****', [i, Memo3.Lines.Count]));

  { über die Klasse, mit gekapseltem Create }
  Memo4.Lines.Clear;
  if TFindAllFiles.StartEx(C, Edit1.Text, '*.*', True) then begin
    try
      repeat
        Memo4.Lines.Add(C.Filename);
      until not C.Next;
      i := C.Count;
    finally
      C.Free;
    end;
  end else i := 0;
  Memo4.Lines.Add(Format('***** %d / %d *****', [i, Memo4.Lines.Count]));
end;
Angehängte Dateien
Dateityp: pas findfiles_197.pas (9,6 KB, 82x aufgerufen)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
Delphi-Tage 2005-2014
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
38.398 Beiträge
 
Delphi 10.4 Sydney
 
#2

Re: FindAllFiles - Iterative

  Alt 8. Dez 2009, 17:19
Bei Zugriffsfehlern und leeren Verzeichnissen (eigentlich nur bei einem leeren Rootverzeichnis) gab es ein kleines Speicher-/Handle-Leck.

Und ich hab noch ein Paar neue Versionen hinzugefügt (siehe letzen Textabschnit und Beispiel-Quellcode in Post #1).
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
Delphi-Tage 2005-2014
  Mit Zitat antworten Zitat
Micha88
(Gast)

n/a Beiträge
 
#3

AW: FindAllFiles - Iterative

  Alt 16. Dez 2011, 21:51
...

Geändert von Micha88 (16. Dez 2011 um 22:06 Uhr)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +2. Es ist jetzt 12:19 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf