Thema: Delphi Dateisuche - rekursiv

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.229 Beiträge
 
Delphi 12 Athens
 
#4

Re: Dateisuche - rekursiv

  Alt 8. Dez 2009, 15:12
Das Ganze komplett auf Callback umzustellen geht noch einfach.
Dieses ginge auch bei der rekursiven Lösung genauso einfach.

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

Function FindAllFilesCallback(Callback: TFAFCallback; Const Dir: String;
    Const Mask: String = '*.*'; Recurse: Boolean = True): Integer;

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

  Begin
    Result := 0;
    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 FindFirst(A[i].Dir + '*.*', faAnyFile, A[i].SR) = 0 Then
        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 Begin
                Inc(Result);
                Callback(A[i].Dir + A[i].SR.Name, Result);
              End;
            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);
            Dec(i);
          End;
        Until i < 0;
    Until i <= 0;
  End;
Hier würde man die Funktion aufrufen und würde jede gefundene Datei sofort
im TFAFCallback geliefert bekommen.
$2B or not $2B
  Mit Zitat antworten Zitat