如何加快Delphi 11中C盘文件搜索速度？替代TDirectory.GetFiles方案？

我需要在Windows 11系统的C:\盘尽可能快地执行文件搜索，但由于C盘包含大量系统文件、Program Files等文件夹，在SSD上搜索耗时超30秒，HDD上耗时更久。当前使用Delphi 11开发64位程序，所用代码如下：

procedure SearchForFiles(const ADirectory, AFileMask: string);
var
  FilesFound: TStringList;
  FileNames: TArray<string>;
  FileName: string;
begin
  FilesFound := TStringList.Create;
  try
    FileNames := TDirectory.GetFiles(ADirectory, AFileMask, TSearchOption.soAllDirectories);
    for FileName in FileNames do
      FilesFound.Add(FileName);

    // Display the results in the memo
    Memo1.Lines.Assign(FilesFound);
  finally
    FilesFound.Free;
  end;
end;

调用代码：

Memo1.Clear; // Clear the memo before searching
SearchForFiles('C:\', '*.txt');

原代码的核心问题是递归遍历C盘所有目录，包括大量系统级文件夹（如Windows、Program Files），这些目录文件量极大且部分文件访问权限受限，导致搜索效率极低。以下是几种可行的优化方案：

1. 跳过无需搜索的系统目录 #

直接在遍历过程中排除非必要的系统目录，大幅减少搜索范围。手动实现递归遍历，遇到指定目录则跳过：

procedure SearchFilesEx(const ADirectory, AFileMask: string; const ExcludeDirs: array of string; FilesFound: TStrings);
var
  SearchRec: TSearchRec;
  FullPath: string;
  IsExcluded: Boolean;
  I: Integer;
begin
  if not DirectoryExists(ADirectory) then Exit;

  // 检查当前目录是否需要排除
  IsExcluded := False;
  for I := 0 to High(ExcludeDirs) do
    if SameText(ExtractFileName(ADirectory), ExcludeDirs[I]) then
    begin
      IsExcluded := True;
      Break;
    end;
  if IsExcluded then Exit;

  // 搜索当前目录下的文件
  if FindFirst(IncludeTrailingPathDelimiter(ADirectory) + AFileMask, faAnyFile, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Attr and faDirectory) = 0 then
        FilesFound.Add(IncludeTrailingPathDelimiter(ADirectory) + SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;

  // 递归搜索子目录
  if FindFirst(IncludeTrailingPathDelimiter(ADirectory) + '*.*', faDirectory, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Attr and faDirectory) <> 0 then
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          FullPath := IncludeTrailingPathDelimiter(ADirectory) + SearchRec.Name;
          SearchFilesEx(FullPath, AFileMask, ExcludeDirs, FilesFound);
        end;
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

// 调用示例
procedure TForm1.Button1Click(Sender: TObject);
var
  FilesFound: TStringList;
begin
  Memo1.Clear;
  FilesFound := TStringList.Create;
  try
    // 排除系统核心目录
    SearchFilesEx('C:\', '*.txt', ['Windows', 'Program Files', 'Program Files (x86)', 'ProgramData'], FilesFound);
    Memo1.Lines.Assign(FilesFound);
  finally
    FilesFound.Free;
  end;
end;

2. 使用多线程并行搜索 #

将C盘顶级目录分配给多个线程并行搜索，利用多核CPU提升效率：

type
  TSearchThread = class(TThread)
  private
    FDirectory: string;
    FFileMask: string;
    FExcludeDirs: array of string;
    FResultList: TStringList;
  protected
    procedure Execute; override;
  public
    constructor Create(const ADirectory, AFileMask: string; const ExcludeDirs: array of string);
    destructor Destroy; override;
    property ResultList: TStringList read FResultList;
  end;

constructor TSearchThread.Create(const ADirectory, AFileMask: string; const ExcludeDirs: array of string);
begin
  inherited Create(True);
  FDirectory := ADirectory;
  FFileMask := AFileMask;
  FExcludeDirs := Copy(ExcludeDirs);
  FResultList := TStringList.Create;
  FreeOnTerminate := False;
end;

destructor TSearchThread.Destroy;
begin
  FResultList.Free;
  inherited;
end;

procedure TSearchThread.Execute;
begin
  SearchFilesEx(FDirectory, FFileMask, FExcludeDirs, FResultList);
end;

// 调用示例
procedure TForm1.Button2Click(Sender: TObject);
var
  Threads: array of TSearchThread;
  TopDirs: TStringList;
  I: Integer;
  FilesFound: TStringList;
  SearchRec: TSearchRec;
begin
  Memo1.Clear;
  TopDirs := TStringList.Create;
  FilesFound := TStringList.Create;
  try
    // 获取C盘顶级目录
    if FindFirst('C:\*.*', faDirectory, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Attr and faDirectory) <> 0 then
          if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
            TopDirs.Add('C:\' + SearchRec.Name);
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;

    // 创建线程处理每个顶级目录
    SetLength(Threads, TopDirs.Count);
    for I := 0 to TopDirs.Count - 1 do
    begin
      Threads[I] := TSearchThread.Create(TopDirs[I], '*.txt', ['Windows', 'Program Files', 'Program Files (x86)', 'ProgramData']);
      Threads[I].Start;
    end;

    // 等待所有线程完成并合并结果
    for I := 0 to High(Threads) do
    begin
      Threads[I].WaitFor;
      FilesFound.AddStrings(Threads[I].ResultList);
      Threads[I].Free;
    end;

    Memo1.Lines.Assign(FilesFound);
  finally
    TopDirs.Free;
    FilesFound.Free;
  end;
end;

3. 调用Windows Search索引服务 #

直接利用Windows内置的搜索索引（已预先索引大部分文件），搜索速度能提升数倍，甚至毫秒级返回结果。需要引入ActiveX和SearchAPI单元：

uses
  ActiveX, ComObj, SearchAPI;

procedure SearchWithWindowsIndex(const AQuery: string; FilesFound: TStrings);
var
  SearchManager: ISearchManager;
  Catalog: ISearchCatalogManager;
  QueryHelper: ISearchQueryHelper;
  Connection: _ADODBConnection;
  RecordSet: _ADODBRecordset;
begin
  CoInitialize(nil);
  try
    // 获取搜索管理器
    SearchManager := CoSearchManager.Create;
    // 获取系统默认目录
    Catalog := SearchManager.GetCatalog('SystemIndex');
    // 创建查询助手
    QueryHelper := Catalog.GetQueryHelper;

    // 设置查询语句：搜索C盘下的txt文件
    QueryHelper.QueryWhereRestrictions := 'AND System.ItemPathDisplay LIKE ''C:\%'' AND System.FileName LIKE ''*.txt''';
    QueryHelper.QuerySelectColumns := 'System.ItemPathDisplay';

    // 执行查询
    Connection := QueryHelper.ExecuteQuery(nil, nil);
    RecordSet := Connection.Execute(QueryHelper.GenerateSQLFromUserQuery(AQuery), EmptyParam, adCmdText);

    // 读取结果
    while not RecordSet.EOF do
    begin
      FilesFound.Add(RecordSet.Fields.Item['System.ItemPathDisplay'].Value);
      RecordSet.MoveNext;
    end;
  finally
    CoUninitialize;
  end;
end;

// 调用示例
procedure TForm1.Button3Click(Sender: TObject);
var
  FilesFound: TStringList;
begin
  Memo1.Clear;
  FilesFound := TStringList.Create;
  try
    SearchWithWindowsIndex('', FilesFound);
    Memo1.Lines.Assign(FilesFound);
  finally
    FilesFound.Free;
  end;
end;

方案对比 #

建议优先尝试Windows Search索引方案，如果需要确保搜索结果绝对完整，再结合多线程+排除目录的方案。

内容的提问来源于stack exchange，提问作者zac