Question

我正在尝试搜索所有子文件夹中的所有文件，因此需要很长时间并且应用程序停止响应，所以我使用了Thread（它第一次使用Threads）我读到了它并且我找到了创建和执行线程的方法，但是当我调用线程时没有任何反应，我不明白为什么我不能在主窗体上使用添加的组件，我不得不重新声明它？
我想念的是什么？

type
  TSearchThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

procedure AddAllFilesInDir(const Path: string; ListBox:TsListBox);
var
  SR: TSearchRec;
  I: Integer;
begin
  if FindFirst(IncludeTrailingBackslash(Path) + '*.*', faAnyFile or faDirectory, SR) = 0 then
    try
      repeat
        if (SR.Attr and faDirectory) = 0 then
            ListBox.Items.Add(Path+'\'+SR.Name)
        else if (SR.Name <> '.') and (SR.Name <> '..') then
          AddAllFilesInDir(IncludeTrailingBackslash(Path) + SR.Name, ListBox);
          Form1.sPanel2.Caption := Path+'\'+SR.Name;
          Form1.sPanel2.Refresh;
          ListBox.Refresh;
      until FindNext(Sr) <> 0;
    finally
      FindClose(SR);
    end;
end;

procedure TSearchThread.Execute;
var FileList: TsListBox;
    I: Integer;
    {Here I had to re-declare objects}
    sDirectoryEdit1: TsDirectoryEdit;
    sListBox1: TsListBox;
begin
      FileList := TsListBox.Create(nil);
      FileList.Parent := sListBox1;
      FileList.Visible := False;
      AddAllFilesInDir(sDirectoryEdit1.Text+'\', FileList);
      for I := 0 to FileList.Count -1 do
      if sListBox1.Items.IndexOf(FileList.Items.Strings[I]) = -1 then
      sListBox1.Items.Add(FileList.Items.Strings[I]);
      FileList.Clear;
end;


procedure TForm1.sDirectoryEdit1Change(Sender: TObject);
begin
    TSearchThread.Create(False);
end;

Answer 1

好的，让我试一试：

首先是你的线程的新版本：

uses
  IOUtils;

type
  TFileFoundEvent = procedure(const Path: string; const SearchRec: TSearchRec) of object;

  TSearchThread = class(TThread)
  private
    FPath: string;
    FSearchRec: TSearchRec;
    FFileFoundEvent: TFileFoundEvent;
  protected
    procedure Execute; override;
  public
    Constructor Create(const aPath: string; aFileFoundEvent: TFileFoundEvent); reintroduce;
  end;

  { TSearchThread }

constructor TSearchThread.Create(const aPath: string; aFileFoundEvent: TFileFoundEvent);
begin
  // Create the Thread non suspended
  inherited Create(false);

  // Copy parameters to local members.
  FFileFoundEvent := aFileFoundEvent;
  FPath := aPath;

  // Make the sure the thread frees itself after execution
  FreeOnTerminate := True;
end;

procedure TSearchThread.Execute;
var
  FilterPredicate: TDirectory.TFilterPredicate;
begin
  // FilterPredicate is an in-place anonymous method to be called each time the TDirectory.GetFiles finds a file
  FilterPredicate := function(const Path: string; const SearchRec: TSearchRec): Boolean
    begin
      // Since we can not access from within Synchronize we need to copy iot to a member of the class
      FSearchRec := SearchRec;

      // You cannot access VCL objects directly from a thread.
      // So you need to call Syncronize
      // For more info look in the online help
      // http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TThread.Synchronize
      Synchronize(nil,
        procedure
        begin
          FFileFoundEvent(FPath, FSearchRec);
        end);

      Result := True;
    end;

  // Do the search
  TDirectory.GetFiles(FPath, TSearchOption.soTopDirectoryOnly, FilterPredicate)
end;

主要的不同之处在于我将回调程序传递给线程的构造函数。因为我使用TDirectory.GetFiles来搜索文件。您会在TDirectory.GetFiles

中找到IOUtils

然后你需要使用它：将一个列表框放在你的上面，然后像这样调用它：

表单定义：

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    procedure FileFoundEvent(const Path: string; const SearchRec: TSearchRec);
  public
    { Public declarations }
  end;

...

implementation

procedure TForm1.FileFoundEvent(const Path: string; const SearchRec: TSearchRec);
begin
  ListBox1.Items.Add(SearchRec.Name);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TSearchThread.Create(ExtractFilePath(Application.ExeName), FileFoundEvent);
end;

如果你不想看到正在进行的搜索结果，而是想要一些速度，你可以创建一个版本的搜索线程，一次性提供结果：

uses
  IOUtils;

type
  TSearchThread = class(TThread)
  private
    FSearchPath: String;
    FResultBuffer: TStrings;
  protected
    procedure Execute; override;
  public
    constructor Create(const aSearchPath: string; aResultBuffer: TStrings); overload;
  end;

constructor TSearchThread.Create(const aSearchPath: string; aResultBuffer: TStrings);
begin
  inherited Create(false);
  FSearchPath := IncludeTrailingPathDelimiter(aSearchPath);
  FResultBuffer := aResultBuffer;
  FreeOnTerminate := True;
end;

procedure TSearchThread.Execute;
var
  FBuffer: TStringlist;
  Filename: String;
begin
  Synchronize(nil,
    procedure
    begin
      FResultBuffer.Text := 'Searching ' + FSearchPath;
    end);

  FBuffer := TStringlist.Create;
  for Filename in TDirectory.GetFiles(FSearchPath, TSearchOption.soAllDirectories, nil) do
    FBuffer.Add(Filename);

  Synchronize(nil,
    procedure
    begin
      FResultBuffer.Assign(FBuffer);
    end);

  FreeAndNil(FBuffer);
end;

这个帖子你必须以不同的方式打电话。

表单设置我仍然和以前一样：表单上的列表框。

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    Stopwatch: TStopwatch;
    procedure SearchThreadTerminate(Sender: TObject);
  public
    { Public declarations }
  end;

然后执行：

procedure TForm1.FormCreate(Sender: TObject);
begin
  Stopwatch := TStopwatch.StartNew;

  with TSearchThread.Create('C:\Program Files (x86)\Embarcadero\', ListBox1.Items) do
    OnTerminate := SearchThreadTerminate;
end;

procedure TForm1.SearchThreadTerminate(Sender: TObject);
begin
  Stopwatch.Stop;
  Caption := 'Elapsed Milliseconds: ' + IntToStr(Stopwatch.ElapsedMilliseconds) + ' Files found: ' + IntToStr(ListBox1.Items.Count);
end;

这个版本的优点是速度。更新屏幕很慢，第一个解决方案更新了它找到的每个文件的屏幕，而这个只更新屏幕两次。

试一试。

Delphi Thread不运行

1 个答案: