Поиск файлов по маске в заданной директории

{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}

unit
 MainFrm;

interface


uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, FileCtrl, Grids, Outline, DirOutln;

type

  TMainForm = class
(TForm)
    dcbDrives: TDriveComboBox;
    edtFileMask: TEdit;
    lblFileMask: TLabel;
    btnSearchForFiles: TButton;
    lbFiles: TListBox;
    dolDirectories: TDirectoryOutline;
    procedure
 btnSearchForFilesClick(Sender: TObject);
    procedure
 dcbDrivesChange(Sender: TObject);
  private

    FFileName: string
;
    function
 GetDirectoryName(Dir: string
): string
;
    procedure
 FindFiles(APath: string
);
  end
;

var

  MainForm: TMainForm;

implementation


{$R *.DFM}

function
 TMainForm.GetDirectoryName(Dir: string
): string
;
{ This function formats the directory name so that it is a valid
  directory containing the back-slash () as the last character. }
begin

  if
 Dir[Length(Dir)] <> '' then

    Result := Dir + ''
  else

    Result := Dir;
end
;

procedure
 TMainForm.FindFiles(APath: string
);
{ This is a procedure which is called recursively so that it finds the
  file with a specified mask through the current directory and its
  sub-directories. }
var

  FSearchRec,
    DSearchRec: TSearchRec;
  FindResult: integer;

  function
 IsDirNotation(ADirName: string
): Boolean;
  begin

    Result := (ADirName = '.') or
 (ADirName = '..');
  end
;

begin

  APath := GetDirectoryName(APath); // Obtain a valid directory name
  { Find the first occurrence of the specified file name }
  FindResult := FindFirst(APath + FFileName, faAnyFile + faHidden +
    faSysFile + faReadOnly, FSearchRec);
  try

    { Continue to search for the files according to the specified
      mask. If found, add the files and their paths to the listbox.}
    while
 FindResult = 0 do

    begin

      lbFiles.Items.Add(LowerCase(APath + FSearchRec.Name));
      FindResult := FindNext(FSearchRec);
    end
;

    { Now search the sub-directories of this current directory. Do this
      by using FindFirst to loop through each subdirectory, then call
      FindFiles (this function) again. This recursive process will
      continue until all sub-directories have been searched. }
    FindResult := FindFirst(APath + '*.*', faDirectory, DSearchRec);

    while
 FindResult = 0 do

    begin

      if
 ((DSearchRec.Attr and
 faDirectory) = faDirectory) and
 not

        IsDirNotation(DSearchRec.Name) then

        FindFiles(APath + DSearchRec.Name); // Recursion here
      FindResult := FindNext(DSearchRec);
    end
;
  finally

    FindClose(FSearchRec);
  end
;
end
;

procedure
 TMainForm.btnSearchForFilesClick(Sender: TObject);
{ This method starts the searching process. It first changes the cursor
  to an hourglass since the process may take awhile. It then clears the
  listbox and calls the FindFiles() function which will be called
  recursively to search through sub-directories }
begin

  Screen.Cursor := crHourGlass;
  try

    lbFiles.Items.Clear;
    FFileName := edtFileMask.Text;
    FindFiles(dolDirectories.Directory);
  finally

    Screen.Cursor := crDefault;
  end
;
end
;

procedure
 TMainForm.dcbDrivesChange(Sender: TObject);
begin

  dolDirectories.Drive := dcbDrives.Drive;
end
;

end
.

Другое по теме:

• Удаление каталога со всем содержимым
• Копирование файлов вместе с каталогами
• Определение размера каталога