Delphi search for files in a thread

Question

Got this pretty straight forward function to search for files:

function FindFiles(const Path, Mask: string; IncludeSubDir: boolean): integer;
var
  FindResult: integer;
  SearchRec: TSearchRec;
begin
  Result := 0;
  FindResult := FindFirst(Path + Mask, faAnyFile - faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    //!!!!!!!! This must synchronize Form1.Memo2.Lines.Add(Path + SearchRec.Name);
    Result := Result + 1;
    FindResult := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  if not IncludeSubDir then
    Exit;
  FindResult := FindFirst(Path + '*.*', faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
      Result := Result + FindFiles(Path + SearchRec.Name + '\', Mask, True);
      FindResult := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

It is called with :

FindFiles('C:\','*.*',TRUE)

How to break this into Delphi thread? This code suits my needs (d2010) I just need to put it (or parts of it) into a thread. Thanks

Answer 1

Maybe something like this?

unit Unit2;

interface

uses
  SysUtils, Classes;

type
  TFileSearcher = class(TThread)
  private
    { Private declarations }
    FPath, FMask: string;
    FIncludeSubDir: boolean;
    FItems: TStrings;
    function FindFiles: integer;
    procedure UpdateTheMemo;
  public
    constructor Create(CreateSuspended: boolean; const Path, Mask: string; IncludeSubDir: boolean);
  protected
    procedure Execute; override;
  end;

implementation

uses Unit1;

{ TFileSearcher }

constructor TFileSearcher.Create(CreateSuspended: boolean; const Path, Mask: string;
  IncludeSubDir: boolean);
begin
  inherited Create(CreateSuspended);
  FPath := Path;
  FMask := Mask;
  FIncludeSubDir := IncludeSubDir;
end;

procedure TFileSearcher.Execute;
begin
  FItems := TStringList.Create;
  try
    FindFiles;
    Synchronize(UpdateTheMemo);
  finally
    FItems.Free;
  end;
end;

procedure TFileSearcher.UpdateTheMemo;
begin
  Form1.Memo2.Lines.Assign(FItems);
end;

function TFileSearcher.FindFiles: integer;
var
  FindResult: integer;
  SearchRec: TSearchRec;
  ThisPath: string;
begin
  ThisPath := FPath;
  Result := 0;
  FindResult := FindFirst(FPath + FMask, faAnyFile - faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    FItems.Add(FPath + SearchRec.Name);
    Result := Result + 1;
    FindResult := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  if not FIncludeSubDir then
    Exit;
  FindResult := FindFirst(IncludeTrailingBackslash(ThisPath) + '*.*', faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
    begin
      FPath := IncludeTrailingBackslash(ThisPath + SearchRec.Name);
      FIncludeSubDir := true;
      Result := Result + FindFiles();
    end;
    FindResult := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

end.

If you want the items to be added to the VCL control one-by-one you lose some of the benefits of threading, but sure, it can be done:

unit Unit2;

interface

uses
  SysUtils, Classes;

type
  TFileSearcher = class(TThread)
  private
    { Private declarations }
    FPath, FMask: string;
    FIncludeSubDir: boolean;
    FItemToAdd: string;
    function FindFiles: integer;
    procedure UpdateTheMemo;
  public
    constructor Create(CreateSuspended: boolean; const Path, Mask: string; IncludeSubDir: boolean);
  protected
    procedure Execute; override;
  end;

implementation

uses Unit1;

{ TFileSearcher }


constructor TFileSearcher.Create(CreateSuspended: boolean; const Path, Mask: string;
  IncludeSubDir: boolean);
begin
  inherited Create(CreateSuspended);
  FPath := Path;
  FMask := Mask;
  FIncludeSubDir := IncludeSubDir;
end;

procedure TFileSearcher.Execute;
begin
  FindFiles;
end;

procedure TFileSearcher.UpdateTheMemo;
begin
  Form1.Memo2.Lines.Add(FItemToAdd);
end;

function TFileSearcher.FindFiles: integer;
var
  FindResult: integer;
  SearchRec: TSearchRec;
  ThisPath: string;
begin
  ThisPath := FPath;
  Result := 0;
  FindResult := FindFirst(FPath + FMask, faAnyFile and not faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    FItemToAdd := FPath + SearchRec.Name;
    Synchronize(UpdateTheMemo);
    Result := Result + 1;
    FindResult := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  if not FIncludeSubDir then
    Exit;
  FindResult := FindFirst(IncludeTrailingBackslash(ThisPath) + '*.*', faDirectory, SearchRec);
  while FindResult = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
    begin
      FPath := IncludeTrailingBackslash(ThisPath + SearchRec.Name);
      FIncludeSubDir := true;
      Result := Result + FindFiles();
    end;
    FindResult := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

end.