unit uSearchThread;
 
interface
 
uses
  Classes, SysUtils;
 
type
  // Поиск файлов соответствующих маске или кроме тех, которые соответствуют маске
  TFilterMethod = (fmIncludeMasks, fmExcludeMasks);
 
  // типы событий
  TFoundFileEvent = procedure (Sender: TObject;
                               const FileName: string;
                               const Size: Int64;
                               const DateTime: TDateTime) of object;
  TFolderChangeEvent = procedure (Sender: TObject;
                                  const NewPath: string) of object;
 
  // Класс-нить для поиска файлов по маскам в заданном каталоге
  TSearchThread = class(TThread)
  private
    // Поля
    FSearchPath: string; // путь поиска
    FMasks: TStrings; // список масок для поиска
    FFilterMethod: TFilterMethod; // способ фильтрации файлов
    FIncludeSubfolders: Boolean; // флаг поиска в подкаталогах
    FInProgress: Boolean; // флаг "в процессе"
    FCount: Cardinal; // кол-во найденных файлов
    FCurrentFolder: string; // каталог, в котором ведётся поиск в данный момент
    FCurrentFile: string; // очеденой найденный файл
    FCurrentFileSize: Int64; // размер найденного файла
    FCurrentFileTime: TDateTime; // время файла
    FOnFileFound: TFoundFileEvent; // событие при нахождении очередного файла
    FOnFolderChange: TFolderChangeEvent; // событие при вхождении в очередной каталог
 
    // Функции доступа к полям/свойствам
 
    // Технологические функции
    function MatchesMask(const S, Mask: string): Boolean; // Соответствие имени файла маске
    function MatchesMasks(const S: string): Boolean; // Соответствие имени файла одной из масок списка
    procedure FindFiles(const APath: string); // поиск файлов
  protected
    procedure Execute; override;
    procedure DoOnFileFound;
    procedure DoOnFolderChange;
  public
    constructor Create(const ASearchPath: string;
                       AMasks: TStrings;
                       const AFilterMethod: TFilterMethod;
                       const AIncludeSubfolters: Boolean = True); reintroduce;
 
    // Методы
    procedure Start;
    procedure Stop;
 
    // Свойства
    property Count: Cardinal read FCount;
    property CurrentFolder: string read FCurrentFolder;
    property InProgress: Boolean read FInProgress;
 
    // События
    property OnFileFound: TFoundFileEvent read FOnFileFound write FOnFileFound;
    property OnFolderChange: TFolderChangeEvent read FOnFolderChange write FOnFolderChange;
  end;
 
 
implementation
 
{ TSearchThread }
 
constructor TSearchThread.Create(const ASearchPath: string;
                                 AMasks: TStrings;
                                 const AFilterMethod: TFilterMethod;
                                 const AIncludeSubfolters: Boolean = True);
var
  Index: Integer;
begin
  inherited Create(True);
 
  FSearchPath:=        ASearchPath;
  FMasks:=             AMasks;
 
  for Index:= 0 to FMasks.Count - 1 do
    FMasks[Index]:= AnsiLowerCaseFileName(FMasks[Index]);
 
  FFilterMethod:=      AFilterMethod;
  FIncludeSubfolders:= AIncludeSubfolters;
end;
 
procedure TSearchThread.DoOnFileFound;
begin
  if Assigned(FOnFileFound)
    then FOnFileFound(Self, FCurrentFile, FCurrentFileSize, FCurrentFileTime);
end;
 
procedure TSearchThread.DoOnFolderChange;
begin
  if Assigned(FOnFolderChange)
    then FOnFolderChange(Self, FCurrentFolder);
end;
 
procedure TSearchThread.Execute;
begin
  FInProgress:= True;
  FindFiles(FSearchPath);
  FInProgress:= False;
end;
 
 
procedure TSearchThread.FindFiles(const APath: string);
var
  Rec: TSearchRec;
  Condition: Boolean;
  FindResult: Integer;
begin
  // Поиск в каталоге
 
  // вызов события
  FCurrentFolder:= APath;
  Synchronize(DoOnFolderChange);
 
  FindResult:= FindFirst(APath + '\*.*', faAnyFile, Rec);
  try
    if FindResult = 0
      then repeat
             if Terminated
               then Break; // Прерывание
 
             if (Rec.Name <> '.') and (Rec.Name <> '..')
               then begin
                      // Наткнулся на файл
                      if Rec.Attr and faDirectory = 0
                        then begin
                               if FFilterMethod = fmIncludeMasks
                                 then Condition:= MatchesMasks(AnsiLowerCase(Rec.Name))
                                 else Condition:= not MatchesMasks(AnsiLowerCase(Rec.Name));
 
                               if Condition
                                 then begin
                                        // вызов события
                                        Inc(FCount);
                                        FCurrentFile:= APath + '\' + Rec.Name;
                                        FCurrentFileSize:= Rec.Size;
                                        FCurrentFileTime:= FileDateToDateTime(Rec.Time);
                                        Synchronize(DoOnFileFound);
                                      end;
                             end
 
                        // Наткнулся на каталог
                        else if FIncludeSubfolders
                               then FindFiles(APath + '\' + Rec.Name);
                    end;
           until FindNext(Rec) <> 0;
  finally
    FindClose(Rec);
  end;
end;
 
function TSearchThread.MatchesMask(const S, Mask: string): Boolean;
var
  si, mi: Integer;
  b: Boolean;
begin
  // Соответствие имени файла маске
  if Mask = ''
    then begin
           Result:= True;
           Exit;
         end;
 
    si:= 1;
    mi:= 1;
 
    while mi <= Length(mask) do
      begin
        case mask[mi] of
          '?': begin
                 Inc(si);
                 Inc(mi);
                 Continue;
               end; // '?':
 
          '*': begin
                 if mi = Length(mask)
                   then begin
                          Result:= True;
                          Exit
                        end;
 
                 Inc(mi);
 
                 while si <= Length(s) + 1 do
                   begin
                     b := MatchesMask(Copy(s, si, Length(s) - si + 1),
                                      Copy(mask, mi, Length(mask) - mi + 1));
                     if b
                       then begin
                              Result:= True;
                              Exit
                            end;
 
                     Inc(si);
                   end; // while
 
                 Result:= False;
                 Exit;
               end; // '*':
          else begin
                 if si > Length(s)
                   then begin
                          Result:= False;
                          Exit
                        end;
 
                 if s[si] <> mask[mi]
                   then begin
                          Result:= False;
                          Exit;
                        end;
               end // else
        end; // case
 
        Inc(si);
        Inc(mi);
    end; // while
 
  Result:= (si = Length(s) + 1) and (mi = Length(mask) + 1);
end;
 
function TSearchThread.MatchesMasks(const S: string): Boolean;
var
  Index: Integer;
begin
  if FMasks.Count = 0  // если маски не заданы
    then begin
           Result:= True;
           Exit;
         end;
 
  for Index:= 0 to FMasks.Count - 1 do
    begin
      Result:= MatchesMask(S, FMasks[Index]);
 
      if Result
        then Exit;
    end;
 
  Result:= False;
end;
 
procedure TSearchThread.Start;
begin
  if not FInProgress
    then begin
           FCount:= 0;
           Resume();
         end;
end;
 
procedure TSearchThread.Stop;
begin
  Self.Terminate();
end;
 
end.