Einzelnen Beitrag anzeigen

omata

Registriert seit: 26. Aug 2004
Ort: Nebel auf Amrum
3.154 Beiträge
 
Delphi 7 Enterprise
 
#15

Re: Klasse für FindFirstFile/FindNextFile

  Alt 30. Apr 2010, 00:57
Was soll die Frage? Wie wäre es mit realisieren...

Delphi-Quellcode:
unit FindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string;
                          const Info: TWin32FindData;
                          var Cancel: Boolean) of object;
  TOnDirectoryFind = procedure(Directory: string;
                               const Info: TWin32FindData;
                               var Cancel: Boolean) of object;
  TOnDirectoryUp = procedure(FromDirectory, ToDirectory: string;
                             var Cancel: Boolean) of object;
  TFindFiles = class
  private
    FSubfolders: Boolean;
    FMask: string;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnDirectoryFind;
    FOnDirectoryUp: TOnDirectoryUp;
    FCancel: Boolean;
    procedure Search(RootFolder: string);
  public
    constructor Create;
    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;
    property OnDirectoryUp: TOnDirectoryUp
      read FOnDirectoryUp write FOnDirectoryUp;
    procedure Find(RootFolder: string);
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
  FOnFindFile:=nil;
  FOnFindDirectory:=nil;
  FOnDirectoryUp:=nil;
end;

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

procedure TFindFiles.Find(RootFolder: string);
begin
  FCancel := False;
  Search(RootFolder);
end;

end.
  Mit Zitat antworten Zitat