How to Search a File through all the SubDirectories in Delphi
Asked Answered
U

6

6

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

Unknit answered 1/7, 2011 at 9:29 Comment(1)
#6537025Evoy
A
12

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;
Anchylose answered 1/7, 2011 at 10:34 Comment(14)
Just to clarify, "You can't apply a restriction to the file extension", because then directories won't get enumerated.Crapshooter
@Sertac Thanks. I was imprecise and have updated the answer accordingly.Anchylose
In addition, even if a directory would be found, say C:\SomeDir, it would not be possible to search `C:*.ini\SomeDir`.Evoy
Thanks to all. Curiously enough i figured out the same after racking my brain enough. Guess i should have checked this one earlier.Unknit
Actually, you can specify the extension but then you need to use two search variables. One search would just search for . with faDirectory so you get all folders. The second one would do the specific search within each found folder...Exceptionable
@wim that approach would likely be more efficient tooAnchylose
Which is why I added my own answer below. :-) It killed the recursion and allows a double search. (And even a search on multiple disks!)Exceptionable
@DavidHeffernan I have tried your Code but it returns . and .. every time for the NamePushy
@Pushy No it doesn't. Likely you've made a mistake when you transcribed the code into your program.Anchylose
@DavidHeffernan I have just copied your Code xDPushy
@Pushy I doubt it. Works just fine right hereAnchylose
@DavidHeffernan Now i have checked it againi and it Returns Nothing. The only Thing in changed know is that i have put a string instead of lbSearchResult makes that a big difference? Or am I just outputing the first element?Pushy
@Pushy I'm not really interested in trying to debug your code that I cannot see. The code in the question works perfectly well.Anchylose
@DavidHeffernan i will try to debug in on my own I think i can find the issue later after some breakPushy
W
12

Here is a more modern approach that gets rid of the headache between 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;
Winzler answered 28/3, 2017 at 16:43 Comment(3)
Hi! It would be very nice of you to provide some explanation for the code you pasted. Thanks!Typhus
While this code snippet may solve the question, including an explanation really helps to improve the quality of your post. Remember that you are answering the question for readers in the future, and those people might not know the reasons for your code suggestion.Grasp
I have edited this answer to give some level of explanation, more than what was originally written.Shavonda
E
4

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...

Exceptionable answered 1/7, 2011 at 13:58 Comment(6)
I'd vote this up if it didn't use SetLength(.., Length()+1).Anchylose
What's wrong with SetLength(.., Length()+1)? Would you rather allocate a larger buffer? Use a linked-list instead? Ot a TStringList to maintain the folder list? Plenty of options to choose from.Exceptionable
A string list would be my choice. SetLength(.., Length()+1) is liable to lead to memory fragmentation.Anchylose
True, but so does a stringlist, although stringlists do allocate slightly bigger chunks of data. Then again, these chunks are multiples of 4 bytes, since a string is technically speaking a pointer to a PChar. So the actual string allocation would still add memory fragmentation. On the other hand, when the function ends, it should have de-allocated all memory that it allocated, thus cleaning up the fragmentation again.Exceptionable
You don't understand address space fragmentation. What happens is that you get little holes in your address space that the MM can't re-use and eventually it becomes impossible to find large contiguous blocks of address space. You also give the MM problems with re-use.Anchylose
This code does not work. if FindFirst(directory + '*.*', faDirectory, search) = 0 then will NOT return directories only. "The Attr parameter specifies the special files to include in addition to all normal files."Shaving
L
0

This is worked for me with multi-extension search support:

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;

Usage:

FileList := TStringList.Create;
FileSearch(s, '.txt;.tmp;.exe;.doc', FileList);
Lanell answered 2/6, 2022 at 16:17 Comment(0)
C
-1

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

Custombuilt answered 5/4, 2018 at 11:52 Comment(0)
A
-3
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.

Airway answered 1/7, 2011 at 10:55 Comment(1)
This code is comparing file attributes and names incorrectly, and is leaking search handles.Interglacial

© 2022 - 2024 — McMap. All rights reserved.