FindAllFiles - Iterative

[himitsu]

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 > FindAllFiles

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;

[himitsu]

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

[Micha88]

...