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;

这里是starter和resultpresenter：

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;

它可能有点过大，但我想稍微编码一下。

如何使用线程进行搜索

2 个答案: