Delphi中如何通过所有子目录搜索文件

Question

我实现了这段代码，但我再次无法搜索子目录。

     procedure TFfileSearch.FileSearch(const dirName:string);
     begin
//We write our search code here
  if FindFirst(dirName,faAnyFile or faDirectory,searchResult)=0 then
  begin
    try
      repeat
      ShowMessage(IntToStr(searchResult.Attr));
        if (searchResult.Attr and faDirectory)=0 then   //The Result is a File
        //begin
          lbSearchResult.Items.Append(searchResult.Name)
         else 
         begin
            FileSearch(IncludeTrailingBackSlash(dirName)+searchResult.Name);
           //
         end;
       until FindNext(searchResult)<>0
     finally
     FindClose(searchResult);
     end;
   end;
   end;
    procedure TFfileSearch.btnSearchClick(Sender: TObject);
   var
 filePath:string;
begin
lbSearchResult.Clear;
if Trim(edtMask.Text)='' then
  MessageDlg('EMPTY INPUT', mtWarning, [mbOK], 0)
else
begin
  filePath:=cbDirName.Text+ edtMask.Text;
  ShowMessage(filePath);
  FileSearch(filePath);

end;

结尾;

我正在 E:\ 驱动器中搜索 *.ini 文件。所以最初的 filePath 是 E:*.ini。 但代码不会搜索 E:\ 驱动器中的目录。如何纠正呢？

提前致谢

Answer 1

您无法在调用 FindFirst 时对文件扩展名应用限制。如果您这样做，则不会枚举目录。相反，您必须检查代码中是否有匹配的扩展名。尝试这样的事情：

procedure TMyForm.FileSearch(const dirName:string);
var
  searchResult: TSearchRec;
begin
  if FindFirst(dirName+'\*', faAnyFile, searchResult)=0 then begin
    try
      repeat
        if (searchResult.Attr and faDirectory)=0 then begin
          if SameText(ExtractFileExt(searchResult.Name), '.ini') then begin
            lbSearchResult.Items.Append(IncludeTrailingBackSlash(dirName)+searchResult.Name);
          end;
        end else if (searchResult.Name<>'.') and (searchResult.Name<>'..') then begin
          FileSearch(IncludeTrailingBackSlash(dirName)+searchResult.Name);
        end;
      until FindNext(searchResult)<>0
    finally
      FindClose(searchResult);
    end;
  end;
end;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  FileSearch('c:\windows');
end;

Answer 2

这是一种更现代的方法，可以消除 FindFirst / FindNext 之间的麻烦：

uses
  System.Types,
  System.IOUtils;

procedure TForm7.Button1Click(Sender: TObject);
var
  S: string;
begin
  Memo1.Lines.Clear;
  for S in TDirectory.GetFiles('C:\test', '*.bmp', TSearchOption.soAllDirectories) do
    Memo1.Lines.Add(S);
  Showmessage('Finished!');
end;

Answer 3

我讨厌那些使用 FindFirst/FindNext 的递归解决方案，我认为这很麻烦，有些人甚至忘记使用 FindClose 来清理资源。因此，为了它的乐趣，一个应该实用的非递归解决方案......

procedure FindDocs(const Root: string);
var
  SearchRec: TSearchRec;
  Folders: array of string;
  Folder: string;
  I: Integer;
  Last: Integer;
begin
  SetLength(Folders, 1);
  Folders[0] := Root;
  I := 0;
  while (I < Length(Folders)) do
  begin
    Folder := IncludeTrailingBackslash(Folders[I]);
    Inc(I);
    { Collect child folders first. }
    if (FindFirst(Folder + '*.*', faDirectory, SearchRec) = 0) then
    begin
      repeat
        if not ((SearchRec.Name = '.') or (SearchRec.Name = '..')) then
        begin
          Last := Length(Folders);
          SetLength(Folders, Succ(Last));
          Folders[Last] := Folder + SearchRec.Name;
        end;
      until (FindNext(SearchRec) <> 0);
      FindClose(SearchRec);
    end;
    { Collect files next.}
    if (FindFirst(Folder + '*.doc', faAnyFile - faDirectory, SearchRec) = 0) then
    begin
      repeat
        if not ((SearchRec.Attr and faDirectory) = faDirectory) then
        begin
          WriteLn(Folder, SearchRec.Name);
        end;
      until (FindNext(SearchRec) <> 0);
      FindClose(SearchRec);
    end;
  end;
end;

虽然它似乎因为使用动态数组而占用大量内存，但递归方法将执行完全相同的操作，但递归发生在堆栈！此外，使用递归方法时，会为所有局部变量分配空间，而我的解决方案仅为文件夹名称分配空间。
当您检查速度时，两种方法应该一样快。不过，递归方法更容易记住。您还可以使用 TStringList 代替动态数组，但我只是喜欢动态数组。
我的解决方案还有一个技巧：它可以在多个文件夹中搜索！我只用一个根初始化了文件夹数组，但您可以轻松地将其长度设置为 3，并将文件夹[0] 设置为 C:\，将文件夹[1] 设置为 D:\，将文件夹[2] 设置为 E:\，然后就可以了将在多个磁盘上搜索！

顺便说一句，将 WriteLn() 代码替换为您想要执行的任何逻辑...

Answer 4

这对我来说适用于多扩展搜索支持：

function GetFilesPro(const Path, Masks: string): TStringDynArray;
var
  MaskArray: TStringDynArray;
  Predicate: TDirectory.TFilterPredicate;
begin
  MaskArray := SplitString(Masks, ',');
  Predicate :=
    function(const Path: string; const SearchRec: TSearchRec): Boolean
    var
      Mask: string;
    begin
      for Mask in MaskArray do
        if MatchesMask(SearchRec.Name, Mask) then
          exit(True);
      exit(False);
    end;
  Result := TDirectory.GetFiles(Path, Predicate);
end;

用法：

FileList := TStringList.Create;
FileSearch(s, '.txt;.tmp;.exe;.doc', FileList);

Answer 5

这个文件搜索的问题是它会无限循环，FindClose就像不存在一样。

Answer 6

procedure FindFilePattern(root:String;pattern:String);
var
  SR:TSearchRec;
begin
  root:=IncludeTrailingPathDelimiter(root);
  if FindFirst(root+'*.*',faAnyFile,SR) = 0 then
  begin
      repeat
          Application.ProcessMessages;
          if ((SR.Attr and faDirectory) = SR.Attr ) and (pos('.',SR.Name)=0) then
             FindFilePattern(root+SR.Name,pattern)
          else
          begin
           if pos(pattern,SR.Name)>0 then Form1.ListBox1.Items.Add(Root+SR.Name);
          end;
      until FindNext(SR)<>0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FindFilePattern('C:\','.exe');
end;

这会递归搜索显示包含特定模式的文件名的所有文件夹。