德尔福线程不运行

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; 

主要diffrence是我传递一个回调proceudre到的构造线。因为我使用TDirectory.GetFiles来搜索文件。从放置一个列表框上的，然后调用它像这样：你会在IOUtils

然后，你需要使用它找到TDirectory.GetFiles

表单定义：

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; 

如果你不想看到正在进行的搜索结果，而是想要一些速度，你可以创建一个searchthread的版本，同时给你结果：

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; 

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

试试吧。