Как получить список файлов в указанной директории, а заодно и список поддиректорий ?

(Для использования этого объекта необходима библиотека TRegExpr )



{$B-}
unit DirScan;

interface

uses
RegExpr,
SysUtils,
Classes;

type
PDirectoryScannerItem = ^TDirectoryScannerItem;
TDirectoryScannerItem = packed record
    Name : string;
    Size : integer;
    LastWriteTime : TDateTime;
  end;

TOnDirScanFileProceed = procedure (Sender : TObject; const ABaseFolder : string;
   const ASearchRecord : TSearchRec; var ACancel : boolean) of object;
TOnDirScanStartFolderScanning = procedure (Sender : TObject; const AFolder : string) of object;
TOnDirScanTimeSlice = procedure (Sender : TObject; var ACancel : boolean) of object;

TCustomDirectoryScanner = class
   private
    fRegExprMask : string;
    fRecursive : boolean;
    fCount : integer;
    fOnFileProceed : TOnDirScanFileProceed;
    fOnStartFolderScanning : TOnDirScanStartFolderScanning;
    fOnTimeSlice : TOnDirScanTimeSlice;
    fMaskRegExpr : TRegExpr;
    function BuildFileListInt (const AFolder : string) : boolean;
   public
    constructor Create;
    destructor Destroy; override;

    property Recursive : boolean read fRecursive write fRecursive;
    property RegExprMask : string read fRegExprMask write fRegExprMask;
// regular expresion for file names masks (like '(\.html?|\.xml)' etc)
    function BuildFileList (AFolder : string) : boolean;
// Build list of all files in folder AFolder.
// If ASubFolder = true then recursivly scans subfolders.
// Returns false if there was file error and user
// decided to terminate process.

    property Count : integer read fCount;
    // matched in last BuildFileList files count

    // Events
    property OnFileProceed : TOnDirScanFileProceed read fOnFileProceed write fOnFileProceed;
    // for each file matched
    property OnStartFolderScanning : TOnDirScanStartFolderScanning read fOnStartFolderScanning write fOnStartFolderScanning;
    // before scanning each directory (starting with root)
    property OnTimeSlice : TOnDirScanTimeSlice read fOnTimeSlice write fOnTimeSlice;
    // for progress bur an so on (called in each internal iteration)
  end;

TDirectoryScanner = class (TCustomDirectoryScanner)
// simple descendant - after BuildFileList call make list of files
// (You can access list thru Item property)
   private
    fList : TList;
    function GetItem (AIdx : integer) : PDirectoryScannerItem;
    procedure KillItem (AIdx : integer);
    procedure FileProceeding (Sender : TObject; const ABaseFolder : string;
     const ASearchRecord : TSearchRec; var ACancel : boolean);
    procedure TimeSlice (Sender : TObject; var ACancel : boolean);
   public
    constructor Create;
    destructor Destroy; override;

    property Item [AIdx : integer] : PDirectoryScannerItem read GetItem;
  end;



implementation

uses
Windows,
Controls, // mrYes
TFUS;

constructor TCustomDirectoryScanner.Create;
begin
  inherited;
  fRecursive := true;
  fOnFileProceed := nil;
  fOnStartFolderScanning := nil;
  fOnTimeSlice := nil;
  fMaskRegExpr := nil;
  fRegExprMask := '';
end; { of constructor TDirectoryScanner.Create
--------------------------------------------------------------}

destructor TCustomDirectoryScanner.Destroy;
begin
  fMaskRegExpr.Free;
  inherited;
end; { of destructor TCustomDirectoryScanner.Destroy
--------------------------------------------------------------}

function TCustomDirectoryScanner.BuildFileList (AFolder : string) : boolean;
begin
  if (length (AFolder) > 0) and (AFolder [length (AFolder)] = '\')
   then AFolder := copy (AFolder, 1, length (AFolder) - 1);

  fMaskRegExpr := TRegExpr.Create;
  fMaskRegExpr.Expression := RegExprMask;

  fCount := 0;
  Result := BuildFileListInt (AFolder);
end; { function BuildFileList
--------------------------------------------------------------}

function TCustomDirectoryScanner.BuildFileListInt (const AFolder : string) : boolean;
var
  sr : SysUtils.TSearchRec;
  Canceled : boolean;
begin
  Result := true;
  if Assigned (OnStartFolderScanning)
   then OnStartFolderScanning (Self, AFolder + '\');

  if SysUtils.FindFirst (AFolder + '\' + '*.*', faAnyFile, sr) = 0 then try
       REPEAT
        try
           if (sr.Attr and SysUtils.faDirectory) = SysUtils.faDirectory then begin
             if Recursive and (sr.Name <> '.') and (sr.Name <> '..')
              then Result := BuildFileListInt (AFolder + '\' + sr.Name);
             end
            else begin
               if fMaskRegExpr.Exec (sr.Name) then begin
                Canceled := false;
                if Assigned (OnFileProceed)
                 then OnFileProceed (Self, AFolder, sr, Canceled);
                if Canceled
                 then Result := false;
                inc (fCount);
               end;
             end;
          except on E:Exception do begin
            case MsgBox ('Replacing error',
                  'Can''t replace file contetn due to error:'#$d#$a#$d#$a
                  + E.Message + #$d#$a#$d#$a + 'Continue processing ?',
                  mb_YesNo or mb_IconQuestion) of
              mrYes : Result := false;
              else ; // must be No
             end;
           end;
         end;
        Canceled := false;
        if Assigned (OnTimeSlice)
         then OnTimeSlice (Self, Canceled);
        if Canceled
         then Result := false;
       UNTIL not Result or (SysUtils.FindNext (sr) <> 0);
      finally SysUtils.FindClose (sr);
     end;
  if not Result
   then EXIT;
end; { function BuildFileListInt
--------------------------------------------------------------}

constructor TDirectoryScanner.Create;
begin
  inherited;
  fList := TList.Create;
  OnFileProceed := FileProceeding;
  fOnTimeSlice := TimeSlice;
end; { of constructor TDirectoryScanner.Create
--------------------------------------------------------------}

destructor TDirectoryScanner.Destroy;
var
  i : integer;
begin
  for i := fList.Count - 1 downto 0 do
   KillItem (i);
  fList.Free;
  inherited;
end; { of destructor TDirectoryScanner.Destroy
--------------------------------------------------------------}

procedure TDirectoryScanner.KillItem (AIdx : integer);
var
  p : PDirectoryScannerItem;
begin
  p := PDirectoryScannerItem (fList.Items [AIdx]);
  Dispose (p);
  fList.Delete (AIdx);
end; { of procedure TDirectoryScanner.KillItem
--------------------------------------------------------------}

function TDirectoryScanner.GetItem (AIdx : integer) : PDirectoryScannerItem;
begin
  Result := PDirectoryScannerItem (fList.Items [AIdx]);
end; { of function TDirectoryScanner.GetItem
--------------------------------------------------------------}

procedure TDirectoryScanner.FileProceeding (Sender : TObject; const ABaseFolder : string;
const ASearchRecord : TSearchRec; var ACancel : boolean);
var
  p : PDirectoryScannerItem;
begin
  p := New (PDirectoryScannerItem);
  p.Name := ABaseFolder + '\' + ASearchRecord.Name;
  fList.Add (p);
end; { of procedure TDirectoryScanner.FileProceeding
--------------------------------------------------------------}

procedure TDirectoryScanner.TimeSlice (Sender : TObject; var ACancel : boolean);
begin
  if Count mod 100 = 0
   then Sleep (0);
end; { of procedure TDirectoryScanner.TimeSlice
--------------------------------------------------------------}

end.

Андрей Сорокин
anso.da.ru