如何使用线程进行搜索

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; 

这可能是大了一点，但我想要编码一点。