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;