德爾福線程不運行

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; 

這個版本的優點是速度快。更新屏幕很慢，第一個解決方案更新了它找到的每個文件的屏幕，而這個屏幕只更新屏幕兩次。

試試吧。