AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Klasse für FindFirstFile/FindNextFile

Ein Thema von Luckie · begonnen am 29. Apr 2010 · letzter Beitrag vom 2. Mai 2010
Antwort Antwort
Seite 1 von 6  1 23     Letzte » 
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#1

Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 16:28
Da es immer wieder gefragt wird und ich es jetzt auch mal wieder gebraucht habe, habe ich die API-Funktionen zum Durchsuchen von Verzeichnisses mal in eine kleine Klasse gepackt:

Delphi-Quellcode:
// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url]

unit FindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string) of object;
  TOnDirectoryFind = procedure(Directory: string) of object;
  TFindFiles = class(TObject)
  private
    FSubfolders: Boolean;
    FMask: string;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnDirectoryFind;
  public
    constructor Create;
    procedure Find(RootFolder: string);
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property Mask: string read FMask write FMask;
    property OnFileFind: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnDirectoryFind: TOnDirectoryFind read FOnFindDirectory write FOnFindDirectory;
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
end;

procedure TFindFiles.Find(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
begin
  if RootFolder[Length(RootFolder)] <> '\then
    RootFolder := RootFolder + '\';
  if Self.SubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY =
          FILE_ATTRIBUTE_DIRECTORY then
          if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..') then
          begin
            if Assigned(OnDirectoryFind) then
              OnDirectoryFind(RootFolder + wfd.cFileName);
            Find(RootFolder + wfd.cFileName);
          end;
      until FindNextFile(hFile, wfd) = False;
    finally
      windows.FindClose(hFile);
    end;
  end;
  hFile := FindFirstFile(PChar(RootFolder + Self.Mask), wfd);
  if hFile <> INVALID_HANDLE_VALUE then
  try
    repeat
      if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <>
        FILE_ATTRIBUTE_DIRECTORY then
      begin
        if Assigned(OnFileFind) then
          OnFileFind(RootFolder + wfd.cFileName);
      end;
    until FindNextFile(hFile, wfd) = False;
  finally
    Windows.FindClose(hFile);
  end;
end;

end.
Delphi-Quellcode:
procedure TForm9.Button1Click(Sender: TObject);
var
  FindFiles: TFindFiles;
begin
  FindFiles := TFindFiles.Create;
  try
    FindFiles.SubFolders := True;
    FindFiles.Mask := '*.dpr';
    FindFiles.OnFileFind := OnFindFile;
    FindFiles.OnDirectoryFind := OnFindDirecetory;
    FindFiles.Find(Edit1.Text);
  finally
    FindFiles.Free;
  end;
end;

procedure TForm9.OnFindDirecetory(Directory: string);
begin
  Memo1.Lines.Add(Directory);
  Application.ProcessMessages;
end;

procedure TForm9.OnFindFile(Filename: string);
begin
  Memo1.Lines.Add(Filename);
  Application.ProcessMessages;
end;
@CodeLib Manager: Eventuell kann man das an den von mir schon vorhandenen Beitrag anhängen.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von HeikoAdams
HeikoAdams

Registriert seit: 12. Jul 2004
Ort: Oberfranken
661 Beiträge
 
FreePascal / Lazarus
 
#2

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 16:38
Also erst einmal

Aber warum benutzt Du anstelle von
Delphi-Quellcode:
  if RootFolder[Length(RootFolder)] <> '\then
    RootFolder := RootFolder + '\';
nicht einfach Delphi-Referenz durchsuchenIncludeTrailingPathDelimiter?
RootFolder := IncludeTrailingPathDelimiter(RootFolder);
Jeder kann ein Held werden und Leben retten!
Einfach beim NKR oder der DKMS als Stammzellenspender registrieren! Also: worauf wartest Du noch?
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#3

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 16:45
Weil ich die Unit SysUtils nicht unnötig einbinden will für diese eine Funktion.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Daniel
(Co-Admin)

Registriert seit: 30. Mai 2002
Ort: Hamburg
13.919 Beiträge
 
Delphi 10.4 Sydney
 
#4

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 16:50
Jetzt noch einen Dreizeiler, der die Verwendung demonstriert und dann ist's perfekt.
Daniel R. Wolf
mit Grüßen aus Hamburg
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 16:51
Bei den Folders wäre es wohl besser '*' oder '*.*' als Maske zu nehmen.
(sonst klappt es mit dem rekursiven Suchen eventuell nicht wie geplant)


Es wäre auch ganz praktisch, wenn TWin32FindData auch mit in den Event-Prozeduren (TOnFindFile und Co.) verfügbar wäre.
So hätte man da dann auch gleich einige Zusatzdaten zur Verfügung.
(Dateigröße oder einige Datumangaben sind doch oftmals recht brauchbar und wenn man sie hier schonmal zu Hand hat ...)

Eine Möglichkeit zum Abbrechen ist auch nie verkehrt.

PS: Warum greifst du von innen auf "externe" Property (z.B. Self.SubFolders) zu, obwohl du direkten Zugriff auf das Feld hast?

PSS: Bei RootFolder einen Leerstring zu übergeben, ergibt bestimmt einen netten Effekt.
(auch wenn man ja eh keine relativen Pfade verwenden soll )

Und wie war das nochmal mit den =False- oder =True-Verleichen?

Delphi-Quellcode:
// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url]
// Weitere Autoren: himitsu, omata

unit FindFiles;

{.$DEFINE UsesSysUtils}

interface

uses
  Windows
  {$IFDEF UseSysUtils} , SysUtils, DateUtils {$ENDIF}
  {$IFDEF UseClasses} , Classes {$ENDIF};

type
  TFindFiles = class;
  TOnFindFile = procedure(Sender: TFindFiles; Directory, FileName: string;
                          Level: Integer; const Info: TWin32FindData;
                          var Cancel: Boolean) of object;
  TOnFindDirectory = procedure(Sender: TFindFiles; Directory, DirName: string;
                               Level: Integer; const Info: TWin32FindData;
                               var Cancel: Boolean; var IgnoreDirectory: Boolean) of object;
  TOnDirectoryUp = procedure(Sender: TFindFiles; FromDirectory, ToDirectory: string;
                             var Cancel: Boolean) of object;

  // Cancel > Cancels the entire search process.
  // IgnoreDirectory > Skips the reading of this directory and all its subdirectories.
  // Errors (HRESULT) > NO_ERROR = S_OK = 0
  // > ERROR_FILE_NOT_FOUND = 2 > The system cannot find the file.
  // > ERROR_PATH_NOT_FOUND = 3 > The system cannot find the path.
  // > ERROR_NO_MORE_FILES = 18 > The user set "Cancel" in the callback to TRUE.

  TFindFiles = class
  private
    FMask: string;
    FSubfolders: Boolean;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnFindDirectory;
    FOnDirectoryUp: TOnDirectoryUp;
    FCountFiles: Integer;
    FCountDirectories: Integer;
    FMaxDirectoryLevel: Integer;
    FCancel: Boolean;
    {$IF Declared(TStrings)}
      FStrings: TStrings;
      procedure StringsFindFile(Sender: TFindFiles; Directory, FileName: string;
        Level: Integer; const Info: TWin32FindData; var Cancel: Boolean);
    {$IFEND}
    function Search(RootFolder: string; Level: Integer): HRESULT;
  public
    constructor Create;

    property Mask: string read FMask write FMask;
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property OnFindFile: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnFindDirectory: TOnFindDirectory read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp read FOnDirectoryUp write FOnDirectoryUp;

    function Find(RootFolder: string): HRESULT;

    // This can also be accessed via "Sender" by the callbacks from.
    property CountOfFiles: Integer read FCountFiles;
    property CountOfDirectories: Integer read FCountDirectories;
    property MaximumDirectoryLevel: Integer read FMaxDirectoryLevel;
    property Cancel: Boolean read FCancel;

    class function FindEx(RootFolder, Mask: string; SubFolders: Boolean; OnFindFile: TOnFindFile;
      OnFindDirectory: TOnFindDirectory = nil; OnDirectoryUp: TOnDirectoryUp = nil): HRESULT;
    class function isOK(E: HRESULT): Boolean;
    class function GetErrorStr(E: HRESULT): String;
    class function DecodeFiletime(const FileTime: TFileTime): TDateTime;

    {$IF Declared(TStrings)}
      class function FindEx(RootFolder, Mask: string; SubFolders: Boolean; SL: TStrings): HRESULT; overload;
    {$IFEND}
  end;

implementation

{$IF Declared(TStrings)}
  procedure TFindFiles.StringsFindFile(Sender: TFindFiles; Directory, FileName: string;
    Level: Integer; const Info: TWin32FindData; var Cancel: Boolean);
  begin
    FStrings.Add(Directory + FileName);
  end;
{$IFEND}

function TFindFiles.Search(RootFolder: string; Level: Integer): HRESULT;
var
  wfd: TWin32FindData;
  hFile: THandle;
  Ignore: Boolean;
  Error: HRESULT;
begin
  Result := NO_ERROR;
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if Level > FMaxDirectoryLevel then
    FMaxDirectoryLevel := Level;
  if FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    begin
      try
        repeat
          if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
            if (string(wfd.cFileName) <> '.')
               and (string(wfd.cFileName) <> '..') then
            begin
              Ignore := False;
              if Assigned(FOnFindDirectory) then
                FOnFindDirectory(Self, RootFolder, wfd.cFileName, Level, wfd, FCancel, Ignore);
              if not FCancel and not Ignore then
              begin
                Inc(FCountDirectories);
                Error := Search(RootFolder + wfd.cFileName + '\', Level + 1);
                if Error <> S_OK then Result := Error;
              end;
              if not FCancel and Assigned(FOnDirectoryUp) then
                FOnDirectoryUp(Self, RootFolder + wfd.cFileName, RootFolder, FCancel);
            end;
        until FCancel or not FindNextFile(hFile, wfd);
      finally
        windows.FindClose(hFile);
      end;
    end
    else
      if GetLastError <> ERROR_FILE_NOT_FOUND then
        Result := GetLastError;
  end;
  if not FCancel then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    begin
      try
        repeat
          if wfd.dwFileAttributes and (FILE_ATTRIBUTE_DIRECTORY or FILE_ATTRIBUTE_DEVICE) = 0 then
          begin
            Inc(FCountFiles);
            if Assigned(FOnFindFile) then
              FOnFindFile(Self, RootFolder, wfd.cFileName, Level, wfd, FCancel);
          end;
        until FCancel or not FindNextFile(hFile, wfd);
      finally
        Windows.FindClose(hFile);
      end;
    end
    else
      if GetLastError <> ERROR_FILE_NOT_FOUND then
        Result := GetLastError;
  end;
end;

constructor TFindFiles.Create;
begin
  inherited;
  FMask := '*.*';
  FSubFolders := True;
end;

function TFindFiles.Find(RootFolder: string): HRESULT;
begin
  FCountFiles := 0;
  FCountDirectories := 0;
  FMaxDirectoryLevel := 0;
  FCancel := False;
  Result := Search(RootFolder, 0);
  if (Result = NO_ERROR) and (FCountFiles = 0) then
    Result := ERROR_FILE_NOT_FOUND;
  if FCancel then Result := ERROR_NO_MORE_FILES;
end;

class function TFindFiles.FindEx(RootFolder, Mask: string; SubFolders: Boolean; OnFindFile: TOnFindFile;
  OnFindDirectory: TOnFindDirectory = nil; OnDirectoryUp: TOnDirectoryUp = nil): HRESULT;
var
  FF: TFindFiles;
begin
  FF := TFindFiles.Create;
  try
    FF.Mask := Mask;
    FF.SubFolders := SubFolders;
    FF.OnFindFile := OnFindFile;
    FF.OnFindDirectory := OnFindDirectory;
    FF.OnDirectoryUp := OnDirectoryUp;
    Result := FF.Find(RootFolder);
  finally
    FF.Free;
  end;
end;

class function TFindFiles.isOK(E: HRESULT): Boolean;
begin
  Result := (E <> NO_ERROR) and (E <> ERROR_FILE_NOT_FOUND);
end;

class function TFindFiles.GetErrorStr(E: HRESULT): String;
{$IF Declared(SysErrorMessage)}
  begin
    Result := SysErrorMessage(E);
  end;
{$ELSE}
  var
    Buffer: array[0..255] of Char;
    Len: Integer;
  begin
    Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or
      FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, E, 0, Buffer, SizeOf(Buffer), nil);
    SetString(Result, Buffer, Len);
  end;
{$IFEND}

class function TFindFiles.DecodeFiletime(const FileTime: TFileTime): TDateTime;
{$IF Declared(EncodeDateTime)}
  var
    LocalFileTime: TFileTime;
    SystemTime: TSystemTime;
  begin
    if FileTimeToLocalFileTime(FileTime, LocalFileTime)
      and FileTimeToSystemTime(LocalFileTime, SystemTime) then
    begin
      with SystemTime do
        Result := EncodeDateTime(wYear, wMonth, wDay, wHour, wMinute, wSecond, wMilliseconds);
    end
    else
      Result := -1;
  end;
{$ELSE}
  const
    MonthDays: array[Boolean] of array[1..12] of Word =
      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
  var
    LocalFileTime: TFileTime;
    SystemTime: TSystemTime;
  begin
    if FileTimeToLocalFileTime(FileTime, LocalFileTime)
      and FileTimeToSystemTime(LocalFileTime, SystemTime) then
    begin
      with SystemTime do
      begin
        Dec(wYear);
        Result := wYear * 365 + wYear div 4 - wYear div 100 + wYear div 400 + wDay - 693594
          + MonthDays[(wYear mod 4 = 0) and ((wYear mod 100 <> 0) or (wYear mod 400 = 0))][wMonth]
          + wHour / 24 + wMinute / 1440 + wSecond / 86400 + wMilliseconds / 86400000;
      end;
    end
    else
      Result := -1;
  end;
{$IFEND}

{$IF Declared(TStrings)}
  class function TFindFiles.FindEx(RootFolder, Mask: string; SubFolders: Boolean; SL: TStrings): HRESULT;
  var
    FF: TFindFiles;
  begin
    FF := TFindFiles.Create;
    try
      FF.Mask := Mask;
      FF.SubFolders := SubFolders;
      FF.OnFindFile := FF.StringsFindFile;
      FF.FStrings := SL;
      FF.FStrings.BeginUpdate;
      try
        Result := FF.Find(RootFolder);
      finally
        FF.FStrings.EndUpdate;
      end;
    finally
      FF.Free;
    end;
  end;
{$IFEND}

end.
[edit]
Code entsprechend einiger Kriterienen nachfolgender Posts/Wünsche/Fehler verändert.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#6

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 16:54
@himitsu: Verbesserungen akzeptiert. Das mit dem Abbrechen ist eine gute Idee. Die Struktur habe ich nicht weitergegeben, weil ich in meinem Programm nur den Dateinamen brauchte.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 16:58
Zitat von Luckie:
Die Struktur habe ich nicht weitergegeben, weil ich in meinem Programm nur den Dateinamen brauchte.
Joar, aber vielleicht ist es ja für Andere praktisch und es ergibt sich dadurch nichtmal vom Speicher oder der Laufzeit her einen Nachteil, wenn man es dennoch weitergibt, auch wenn es nicht nötig ist.

PS: Hatte oben noch schnell einen Fehler beseitigt.

[edit] ständig verschreibt man sich -.-°
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.534 Beiträge
 
Delphi 11 Alexandria
 
#8

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 17:01
Dann korrigier die Zeile
Zitat:
hFile := FindFirstFile(PChar(RootFolder + '*.*), wfd);
doch auch gleich noch, da fehlt das abschließende '.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#9

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 17:02
Das habe ich jetzt schon zwei mal gemacht und jedes mal hat er es wieder rückgängig gemacht.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

Re: Klasse für FindFirstFile/FindNextFile

  Alt 29. Apr 2010, 17:04
Ohhh, das ist dann aber blöd ... woher soll ich wissen, daß die DP auf solche Änderungen nicht hinweißt.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:38 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz