How to Search a File through all the SubDirectories in Delphi

问题

I implemented this code but again i am not able to search through the subdirectories .

     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;

end;

I am giving the search for *.ini files in E:\ drive. so initially filePath is E:*.ini. But the code does not search the directories in E:\ drive. How to correct it?

Thanks in Advance

回答1:

You can't apply a restriction to the file extension in the call to FindFirst. If you did so then directories do not get enumerated. Instead you must check for matching extension in your code. Try something like this:

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;

回答2:

I'd recommend doing as follows:

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('Pronto!');
end;

回答3:

I hate those recursive solutions with FindFirst/FindNext and I consider it troublesome that some even forget to use FindClose to clean up resources. So, for the fun of it, a non-recursive solution that should be practical to use...

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;

While it seems to eat a lot of memory because it uses a dynamic array, a recursive method will do exactly the same but recursion happens on the stack! Also, with a recursive method, space is allocated for all local variables while my solution only allocates space for the folder names.
When you check for speed, both methods should be just as fast. The recursive method is easier to remember, though. You can also use a TStringList instead of a dynamic array, but I just like dynamic arrays.
One additional trick with my solution: It can search in multiple folders! I Initialized the Folders array with just one root, but you could easily set it's length to 3, and set Folders[0] to C:\, Folders[1] to D:\ and Folders[2] to E:\ and it will search on multiple disks!

Btw, replace the WriteLn() code with whatever logic you want to execute...

回答4:

The problem with this file search is that it will loop infinitely, FindClose is like it does not exist.

回答5:

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;

This searches recursively to all folders displaying filenames that contain a certain pattern.

来源：https://stackoverflow.com/questions/6546105/how-to-search-a-file-through-all-the-subdirectories-in-delphi