multithreading - Delphi 在一个线程中搜索文件

Question

得到了这个非常直接的功能来搜索文件:

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;

它被称为:

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

如何将其分解为 Delphi 线程？
这段代码适合我的需要(d2010)我只需要将它(或它的一部分)放入一个线程中。
谢谢

Answer 1

也许是这样的？

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.

如果您希望将项目一个一个地添加到 VCL 控件中，您将失去线程的一些好处，但可以肯定的是，可以这样做:

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.