如何使用線程進行搜索

Question

我有一個Tstringlist，其中包含我在磁盤上使用搜索填充的很長文件列表。 該列表包含具有不同擴展名的文件 - .docx .xlsx等 填充此列表是通過一次搜索一個擴展名來完成的，因此需要相當長的時間 我想要做的是使這樣我就可以開始多個搜索，並使用文件名填充相同的TStringList。 我有一個想法，它應該由一些線程來完成，但這對我來說是一張白紙。

任何提示或可能是我應該學習的樣本？

下面的代碼是一個我用今天

function TFiles.Search(aList: TstringList; aPathname: string; const aFile: string = '*.*'; const aSubdirs: boolean = True): integer; 
var 
    Rec: TSearchRec; 
begin 
    Folders.Validate(aPathName, False); 
    if FindFirst(aPathname + aFile, faAnyFile - faDirectory, Rec) = 0 then 
    try 
     repeat 
     aList.Add(aPathname + Rec.Name); 
     until FindNext(Rec) <> 0; 
    finally 
     FindClose(Rec); 
    end; 
    Result := aList.Count; 
    if not aSubdirs then Exit; 
    if FindFirst(aPathname + '*.*', faDirectory, Rec) = 0 then 
    try 
     repeat 
     if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name<>'.') and (Rec.Name<>'..') then 
      Files.Search(aList, aPathname + Rec.Name, aFile, True); 
     until FindNext(Rec) <> 0; 
    finally 
     FindClose(Rec); 
    end; 
    Result := aList.Count; 
end; 

Answer 1

大廈LU RD的建議。

只有遍歷磁盤一次
對所有文件的搜索一次。這樣你只需要遍歷一次目錄，節省了大量的I/O時間。

參見：How to search different file types using FindFirst?

procedure FileSearch(const PathName: string; const Extensions: string; 
        var lstFiles: TStringList); 
// .....(copy code from above link) 

多線程非盤類零件
當你獲得你的文件，您可以搜索使用線程低谷所有這些一次。

就是這樣。

type 
    TSearchThread = class(TThread) 
    private 
    FFilenames: TStringList; 
    FExtensionToSearchFor: string; 
    FResultList: TStringList; 
    protected 
    procedure Execute; override; 
    public 
    constructor Create(AFilelist: TStringlist; Extension: string); 
    property Filenames: TStringList read FFilenames; 
    property ExtensionToSearchFor: string read FExtensionToSearchFor; 
    property ResultList: TStringList read FResultList; 
    end; 

    TForm1 = class(TForm) 
    private 
    FFilenames: TStringList; 
    FWorkerBees: array of TSearchThread; 
    FNumberOfBeesStillWorking: cardinal; 
    procedure WorkerBeeTerminate(Sender: TObject); 
    public 
    procedure LetsWork; 
    procedure AllDone; 
    end; 

implementation 

constructor TSearchThread.Create(AFilelist: TStringList; Extension: string); 
const 
    WaitABit = true; 
begin 
    inherited Create(WaitABit); 
    FResultList:= TStringList.Create; 
    FExtensionToSearchFor:= Extension; 
    FFilenames:= AFilelist; 
    //Self.FreeOnTerminate:= false; 
end; 

procedure TSearchThread.Execute; 
var 
    FilenameI: string; 
begin 
    for i:= 0 to FFilenames.Count -1 do begin 
    FileNameI:= FFilenames[i]; 
    if (ExtractFileExtension(FilenameI) = FExtensionToSearchFor) then begin 
     FResultList.Add(FilenameI); 
    end; 
    end; {for i} 
end; 

procedure TForm1.LetsWork; 
begin 
    FileSearch(PathName, Extensions, FFilenames); 
    SetLength(FWorkerBees, NumberOfExtensions); 
    FNumberOfBeesStillWorking:= NumberOfExtensions; 
    for i:= 0 to NumberOfExtensions - 1 do begin 
    FWorkerBees[i]:= TSearchThread.Create(FFilenames, GetExtensionI(Extensions,i)); 
    FWorkerBees[i].OnTerminate:= WorkerBeeTerminate; 
    FWorkerBees[i].Start; 
    end; {for i} 
end; 

procedure TForm1.WorkerBeeTerminate(Sender: TObject); 
begin 
    Dec(FNumberOfWorkerBeesStillWorking); 
    if FNumberOfWorkerBeesStillWorking = 0 then AllDone; 
end; 

procedure TForm1.AllDone; 
begin 
    //process the ResultLists for all the threads... 
    //Free the threads when done 

時間代碼
但是你要經歷這些麻煩之前...

時間你的代碼，請參閱：Calculating the speed of routines?

只寫一個正常的單線程版本以及每個時間零件。
只有在佔用顯着的運行時間百分比的情況下才對部分進行優化。

探查
一個很酷的工具，我喜歡用爲該目的是：GPProfiler參見：http://code.google.com/p/gpprofile2011/downloads/list

它支持Delphi至少到XE3和或許超出了。

Answer 2

正如其他提到的，我認爲瓶頸是磁盤IO。所以我提出了一個解決方案，它運行在兩個線程中。在第一次我做文件搜索，第二次文件將被過濾。所以搜索和分析是在同一時間。

但是：你的代碼的時間來找到你的瓶頸。

TSearchFilterThread = class(TThread) 
    private 
    fFileQueue: TStringList; 
    fExtensionList: TStringList; 
    fCriticalSection: TCriticalSection; 
    fResultList: TStringList; 
    fNewDataInList: TSimpleEvent; 
    function getNextFileToProcess: string; 
    function matchFilter(const filename: string): boolean; 
protected 
    procedure execute; override; 
public 
    constructor create(searchForExtension: TStringList); reintroduce; 
    destructor destroy; override; 
    procedure appendFile(const filename: string); 
    procedure waitForEnd; 
    property Results: TStringlist read fResultList; 
end; 

procedure TSearchFilterThread.appendFile(const filename: string); 
begin 
    fCriticalSection.Enter; 
    try 
    fFileQueue.Add(filename); 
    fNewDataInList.SetEvent; 
    finally 
    fCriticalSection.Leave; 
    end; 
end; 

constructor TSearchFilterThread.create(searchForExtension: TStringList); 
begin 
    inherited create(true); 
    //To protected acces to the TStringList fFileQueue 
    fCriticalSection := TCriticalSection.Create; 

    fExtensionList := searchForExtension; 
    fExtensionList.Sorted := true; 
    fExtensionList.CaseSensitive := false; 

    fFileQueue := TStringList.Create; 

    //Event to notify workerthread, that new data available 
    fNewDataInList := TSimpleEvent.Create; 
    fNewDataInList.ResetEvent; 

    fResultList := TStringList.Create; 

    resume; 
end; 

destructor TSearchFilterThread.destroy; 
begin 
    terminate; 
    fNewDataInList.SetEvent; 
    waitFor; 

    fResultList.Free; 
    fCriticalSection.Free; 
    fFileQueue.Free; 
    inherited; 
end; 

function TSearchFilterThread.getNextFileToProcess: string; 
begin 
    fCriticalSection.Enter; 
    try 
    if fFileQueue.Count > 0 then begin 
     result := fFileQueue[0]; 
     fFileQueue.Delete(0); 
    end 
    else 
     result := ''; 
    finally 
    fCriticalSection.Leave; 
    end; 
end; 

function TSearchFilterThread.matchFilter(const filename: string): boolean; 
var 
    extension: string; 
begin 
    extension := ExtractFileExt(filename); 
    result := fExtensionList.IndexOf(extension) > -1; 
end; 

procedure TSearchFilterThread.execute; 
const 
    INFINITE: longword = $FFFFFFFF; 
var 
fileName: string; 
begin 
    while true do begin 
    fileName := getNextFileToProcess; 
    if fileName <> '' then begin 
     if matchFilter(filename) then 
     fResultList.Add(fileName); 
    end 
    else if not terminated then begin 
     fNewDataInList.WaitFor(INFINITE); 
     fNewDataInList.resetEvent; 
    end 
    else if terminated then 
     break; 
    end; 
end; 


procedure TSearchFilterThread.waitForEnd; 
begin 
    Terminate; 
    fNewDataInList.SetEvent; 
    waitFor; 
end; 

是找到的所有文件，並委託過濾到thred

procedure FileSearch(const pathName: string; filter: TSearchFilterThread); 
const 
    FileMask = '*.*'; 
var 
    Rec: TSearchRec; 
    Path: string; 
begin 
    Path := IncludeTrailingPathDelimiter(pathName); 
    if FindFirst(Path + FileMask, faAnyFile - faDirectory, Rec) = 0 then 
    try 
     repeat 
     filter.appendFile(Path + rec.Name); 
     until FindNext(Rec) <> 0; 
    finally 
     SysUtils.FindClose(Rec); 
    end; 

    if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then 
    try 
     repeat 
     if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name <> '.') and 
      (Rec.Name <> '..') then 
      FileSearch(Path + Rec.Name, filter); 
     until FindNext(Rec) <> 0; 
    finally 
     FindClose(Rec); 
    end; 
end; 

在這裏啓動和resultpresenter的searchmethod：

procedure TForm1.startButtonClick(Sender: TObject); 
var 
    searchFilter: TSearchFilterThread; 
    searchExtensions: TStringList; 
    path: string; 
begin 
    path := 'c:\windows'; 

    searchExtensions := TStringList.Create; 
    searchExtensions.Add('.doc'); 
    searchExtensions.Add('.docx'); 
    searchExtensions.Add('.ini'); 

    searchFilter := TSearchFilterThread.create(searchExtensions); 
    try 
    FileSearch(path, searchFilter); 
    searchFilter.waitForEnd; 

    fileMemo.Lines := searchFilter.Results; 
    finally 
    searchFilter.Free; 
    searchExtensions.Free; 
    end; 
end; 

這可能是大了一點，但我想要編碼一點。