Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как получить список файлов и поддиректорий в указанной директории

Автор: Андрей Сорокин
WEB-сайт: http://anso.da.ru

Для использования этого объекта необходима библиотека 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, 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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.