2

获得了这个非常简单的功能来搜索文件：

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）我只需要将它（或其中的一部分）放入一个线程中。谢谢

4

3 回答 3

2

也许是这样的？

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.
于 2011-05-23T22:41:29.367 回答
1

可以在此处找到使用消息而不是同步的基于 OmniThreadLibrary 的解决方案。

于 2011-06-30T14:56:24.280 回答
0

看看我的答案Indy 10 IdTCPClient Reading Data using a separate thread？以及其中包含的链接，用于使用匿名方法在线程内运行给定函数的更优雅的方式。这个想法是实现一次TProc在线程内执行任何类的类。然后，匿名方法功能使您可以轻松地TProc就地定义它并访问调用上下文的所有局部变量。

于 2011-05-24T06:52:46.317 回答