Delphi-PRAXiS - Delphi FindAllFiles

Hab hier noch eine Iterative-Lösung von FindAllFiles

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

FindAllFiles :shock:

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;