Perform a file search including subdirectories

Problem/Question/Abstract:

How to perform a file search including subdirectories

Answer:

Solve 1:

Recursively scanning all drives:

{excerpt from form declaration, form has a listbox1 for the  results, a label1 for progress, a button2 to start the scan, an edit1 to get the search mask from, a button3 to stop the scan.}
private
{ Private declarations }
FScanAborted: Boolean;
public
{ Public declarations }

function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;

function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;

  function ScanDirectory(var path: string): Boolean;
  var
    SRec: TSearchRec;
    pathlen: Integer;
    res: Integer;
  begin
    label1.caption := path;
    pathlen := Length(path);
    { first pass, files }
    res := FindFirst(path + filemask, faAnyfile, SRec);
    if res = 0 then
    try
      while res = 0 do
      begin
        hitlist.Add(path + SRec.Name);
        res := FindNext(SRec);
      end;
    finally
      FindClose(SRec)
    end;
    Application.ProcessMessages;
    Result := not (FScanAborted or Application.Terminated);
    if not Result then
      Exit;
    {second pass, directories}
    res := FindFirst(path + ' *.* ', faDirectory, SRec);
    if res = 0 then
    try
      while (res = 0) and Result do
      begin
        if ((Srec.Attr and faDirectory) = faDirectory) and (Srec.name <> ' . ')
          and (Srec.name <> ' .. ') then
        begin
          path := path + SRec.name + '\';
          Result := ScanDirectory(path);
          SetLength(path, pathlen);
        end;
        res := FindNext(SRec);
      end;
    finally
      FindClose(SRec)
    end;
  end;

begin
  FScanAborted := False;
  Screen.Cursor := crHourglass;
  try
    Result := ScanDirectory(root);
  finally
    Screen.Cursor := crDefault
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ch: Char;
  root: string;
begin
  root := 'C:\';
  for ch := 'A' to 'Z' do
  begin
    root[1] := ch;
    case GetDriveType(Pchar(root)) of
      DRIVE_FIXED, DRIVE_REMOTE:
        if not ScanDrive(root, edit1.text, listbox1.items) then
          Break;
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin {aborts scan}
  fScanAborted := True;
end;


Solve 2:

procedure TFrmRecurseDirTree.RecurseDirTree(APath: string; AList: TStrings);
var
  searchRec: TSearchRec;
  thePath: string;
begin
  if (Length(thePath) > 0) then
    Exit;
  {Riffle through the subdirectories and find the file(s) there}
  thePath := APath;
  if (thePath[Length(thePath)] <> '\') then
    thePath := thePath + '\';
  if FindFirst(thePath + '*.*', faDirectory, searchRec) = 0 then
  try
    repeat
      if (searchRec.Attr and faDirectory > 1) and (searchRec.Name <> '.') and
        (searchRec.Name <> '..') then
      begin
        AList.Add(thePath + searchRec.Name);
        RecurseDirTree(thePath + searchRec.Name + '\', AList);
        Application.ProcessMessages;
      end;
    until
      FindNext(searchRec) <> 0;
  finally
    SysUtils.FindClose(searchRec);
  end;
end;


Solve 3:

Here is a procedure to scan for all bitmaps below the current directory and add them to a list. It can easily be modified to add all sub-directories to the list, just add "List.Add..." just before "ScanDirectory..." and delete the part that adds the bitmap filenames. Maybe it's better to change faAnyFile to faDirecory, but I am not sure if this will return all directories including hidden ones etc.

procedure TForm1.ScanDirectory(Path: string; List: TStringList; SubDirFlag: Boolean);
var
  SearchRec: TSearchRec;
  Ext: string;
begin
  if Path[Length(Path)] <> '\' then
    Path := Path + '\';
  if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 then
  begin
    repeat
      if SearchRec.Attr = faDirectory then
      begin
        if SubDirFlag and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          ScanDirectory(Path + SearchRec.Name, List, SubDirFlag);
      end
      else
      begin
        Ext := UpperCase(ExtractFileExt(SearchRec.Name));
        if (Ext = '.BMP') then
        begin
          List.Add(Path + SearchRec.Name);
        end;
      end;
    until
      FindNext(SearchRec) <> 0;
  end;
end;

Use it as follows:

ScanDirectory(GetCurrentDir, YourStringList, False);


Solve 4:

procedure TForm1.Button1Click(Sender: TObject);
var
  SearchRec: TSearchRec;
begin
  if FindFirst('c:\images\*.jpg', faAnyFile, SearchRec) = 0 then
  try
    repeat
      listbox1.items.add(searchrec.name);
    until
      Findnext(SearchRec) <> 0;
  finally
    FindClose(SearchRec);
  end;
end;

Note: if you are displaying many items, you will probably want to wrap the code within listbox1.items.BeginUpdate/EndUpdate.


Solve 5:

Searching for a file in a directory:

function FileExistsExt(const aPath, aFilename: string): Boolean;
var
  DSearchRec: TSearchRec;
begin
  Result := FileExists(IncludeTrailingPathDelimiter(aPath) + aFilename);
  if not Result then
  begin
    if FindFirst(APath + '\*', faDirectory, DSearchRec) = 0 then
    begin
      repeat
        if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
          Result := FileExistsExt(IncludeTrailingPathDelimiter(aPath) +
                                         DSearchRec.Name, aFilename);
      until
        FindNext(DSearchRec) <> 0;
    end;
    FindClose(DSearchRec);
  end;
end;

Usage:

{ ... }
if FileExistsExt('C:', 'Testfile.dat') then
  { ... }


Solve 6:

The following function receives as parameters a file specification (like for example 'C:\My Documents\*.xls' or 'C:\*' if you want to search the entire hard disk) and optionally a set of attributes (exactly as Delphi's FindFirst function), and it returs a StringList with the full pathnames of the found files. You should free the StringList after using it.

interface

function FindFile(const filespec: TFileName; attributes: integer
  = faReadOnly or faHidden or faSysFile or faArchive): TStringList;

implementation

function FindFile(const filespec: TFileName;
  attributes: integer): TStringList;
var
  spec: string;
  list: TStringList;

  procedure RFindFile(const folder: TFileName);
  var
    SearchRec: TSearchRec;
  begin
    // Locate all matching files in the current
    // folder and add their names to the list
    if FindFirst(folder + spec, attributes, SearchRec) = 0 then
    begin
      try
        repeat
          if (SearchRec.Attr and faDirectory = 0) or
            (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
            list.Add(folder + SearchRec.Name);
        until FindNext(SearchRec) <> 0;
      except
        FindClose(SearchRec);
        raise;
      end;
      FindClose(SearchRec);
    end;
    // Now search the subfolders
    if FindFirst(folder + '*', attributes
      or faDirectory, SearchRec) = 0 then
    begin
      try
        repeat
          if ((SearchRec.Attr and faDirectory) <> 0) and
            (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
            RFindFile(folder + SearchRec.Name + '\');
        until FindNext(SearchRec) <> 0;
      except
        FindClose(SearchRec);
        raise;
      end;
      FindClose(SearchRec);
    end;
  end; // procedure RFindFile inside of FindFile

begin // function FindFile
  list := TStringList.Create;
  try
    spec := ExtractFileName(filespec);
    RFindFile(ExtractFilePath(filespec));
    Result := list;
  except
    list.Free;
    raise;
  end;
end;

Sample call

You can try this function placing a ListBox and a button on a form and adding this code to the OnClick event of the button:

procedure TForm1.Button1Click(Sender: TObject);
var
  list: TStringList;
begin
  list := FindFile('C:\Delphi\*.pas');
  ListBox1.Items.Assign(list);
  list.Free;
end;


Solve 7:

I thought if there was a way to create a function that does not recursively call itself to list all the files in the harddisk, so that there might be some improvement in speed, other than making the function more complex there were no speed improvements. Here is the code of the function any way.

type
  PRecInfo = ^TRecInfo;
  Trecinfo = record
    prev: PRecInfo;
    fpathname: string;
    srchrec: Tsearchrec;
  end;

function TForm1.RecurseDirectory1(fname: string): tstringlist;
var
  f1, f2: Tsearchrec;
  p1, tmp: PRecInfo;
  fwc: string;
  fpath: string;
  fbroke1, fbroke2: boolean;
begin
  result := tstringlist.create;
  fpath := extractfilepath(fname);
  fwc := extractfilename(fname);
  new(p1);
  p1.fpathname := fpath;
  p1.prev := nil;
  fbroke1 := false;
  fbroke2 := false;
  while (p1 <> nil) do
  begin
    if (fbroke1 = false) then
      if (fbroke2 = false) then
      begin
        if (findfirst(fpath + '*', faAnyfile, f1) <> 0) then
          break;
      end
      else if (findnext(f1) <> 0) then
      begin
        repeat
          findclose(f1);
          if (p1 = nil) then
            break;
          fpath := p1.fpathname;
          f1 := p1.srchrec;
          tmp := p1.prev;
          dispose(p1);
          p1 := tmp;
        until (findnext(f1) = 0);
        if (p1 = nil) then
          break;
      end;
    if ((f1.Name <> '.') and (f1.name <> '..') and ((f1.Attr and fadirectory) =
      fadirectory)) then
    begin
      fbroke1 := false;
      new(tmp);
      with tmp^ do
      begin
        fpathname := fpath;
        srchrec.Time := f1.time;
        srchrec.Size := f1.size;
        srchrec.Attr := f1.attr;
        srchrec.Name := f1.name;
        srchrec.ExcludeAttr := f1.excludeattr;
        srchrec.FindHandle := f1.findhandle;
        srchrec.FindData := f1.FindData;
      end;
      tmp.prev := p1;
      p1 := tmp;
      fpath := p1.fpathname + f1.name + '\';
      if findfirst(fpath + fwc, faAnyfile, f2) = 0 then
      begin
        result.add(fpath + f2.Name);
        while (findnext(f2) = 0) do
          result.add(fpath + f2.Name);
        findclose(f2);
      end;
      fbroke2 := false;
    end
    else
    begin
      if (findnext(f1) <> 0) then
      begin
        findclose(f1);
        fpath := p1.fpathname;
        f1 := p1.srchrec;
        fbroke1 := false;
        fbroke2 := true;
        tmp := p1.prev;
        dispose(p1);
        p1 := tmp;
      end
      else
      begin
        fbroke1 := true;
        fbroke2 := false;
      end;
    end;
  end;
  fpath := extractfilepath(fname);
  if findfirst(fname, faAnyfile, f1) = 0 then
  begin
    result.add(fpath + f2.Name);
    while (findnext(f1) = 0) do
      result.add(fpath + f2.Name);
    findclose(f1);
  end;
end;