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

Andreas Rejbrand · Accepted Answer · 2011-05-24T05:11:45.543

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.

@Rawn: I fixed a bug a minute ago. Did you try the new version? — Andreas Rejbrand, May 23 '11 at 23:04
It updates the memo only at the end of the search. It looks like it needs to be synchronized somewhere in the middle of the FindFiles function. Can you help? — , May 24 '11 at 00:05

score 1 · Answer 2 · answered Jun 30 '11 at 14:56

1

An OmniThreadLibrary-based solution which uses messages instead of Synchronize can be found here.

answered Jun 30 '11 at 14:56

gabr

26,580
9
75
141

score 0 · Answer 3 · edited May 23 '17 at 10:00

Look at my answer Indy 10 IdTCPClient Reading Data using a separate thread? and the link contained in it for a more elegant way of running a given function inside a thread using anonymous methods. The idea is to implement once a class that executes any TProc inside a thread. The anonymous method feature then lets you easily define this TProcin-place and with access to all local variables of the calling context.

Delphi search for files in a thread

3 Answers3