Thema: Delphi Dateisuche - rekursiv

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.033 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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat