Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to perform a file search including subdirectories Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
30-Aug-02
Category
Files Operation
Language
Delphi All Versions
Views
46
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

How to perform a file search including subdirectories

Answer:

Solve 1:

Recursively scanning all drives:
1   
2   {excerpt from form declaration, form has a listbox1 for the  results, a label1 for 
3   progress, a button2 to start the scan, an edit1 to get the search mask from, a 
4   button3 to stop the scan.}
5   private
6   { Private declarations }
7   FScanAborted: Boolean;
8   public
9   { Public declarations }
10  
11  function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
12  
13  function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
14  
15    function ScanDirectory(var path: string): Boolean;
16    var
17      SRec: TSearchRec;
18      pathlen: Integer;
19      res: Integer;
20    begin
21      label1.caption := path;
22      pathlen := Length(path);
23      { first pass, files }
24      res := FindFirst(path + filemask, faAnyfile, SRec);
25      if res = 0 then
26      try
27        while res = 0 do
28        begin
29          hitlist.Add(path + SRec.Name);
30          res := FindNext(SRec);
31        end;
32      finally
33        FindClose(SRec)
34      end;
35      Application.ProcessMessages;
36      Result := not (FScanAborted or Application.Terminated);
37      if not Result then
38        Exit;
39      {second pass, directories}
40      res := FindFirst(path + ' *.* ', faDirectory, SRec);
41      if res = 0 then
42      try
43        while (res = 0) and Result do
44        begin
45          if ((Srec.Attr and faDirectory) = faDirectory) and (Srec.name <> ' . ')
46            and (Srec.name <> ' .. ') then
47          begin
48            path := path + SRec.name + '\';
49            Result := ScanDirectory(path);
50            SetLength(path, pathlen);
51          end;
52          res := FindNext(SRec);
53        end;
54      finally
55        FindClose(SRec)
56      end;
57    end;
58  
59  begin
60    FScanAborted := False;
61    Screen.Cursor := crHourglass;
62    try
63      Result := ScanDirectory(root);
64    finally
65      Screen.Cursor := crDefault
66    end;
67  end;
68  
69  procedure TForm1.Button2Click(Sender: TObject);
70  var
71    ch: Char;
72    root: string;
73  begin
74    root := 'C:\';
75    for ch := 'A' to 'Z' do
76    begin
77      root[1] := ch;
78      case GetDriveType(Pchar(root)) of
79        DRIVE_FIXED, DRIVE_REMOTE:
80          if not ScanDrive(root, edit1.text, listbox1.items) then
81            Break;
82      end;
83    end;
84  end;
85  
86  procedure TForm1.Button3Click(Sender: TObject);
87  begin {aborts scan}
88    fScanAborted := True;
89  end;



Solve 2:
90  
91  procedure TFrmRecurseDirTree.RecurseDirTree(APath: string; AList: TStrings);
92  var
93    searchRec: TSearchRec;
94    thePath: string;
95  begin
96    if (Length(thePath) > 0) then
97      Exit;
98    {Riffle through the subdirectories and find the file(s) there}
99    thePath := APath;
100   if (thePath[Length(thePath)] <> '\') then
101     thePath := thePath + '\';
102   if FindFirst(thePath + '*.*', faDirectory, searchRec) = 0 then
103   try
104     repeat
105       if (searchRec.Attr and faDirectory > 1) and (searchRec.Name <> '.') and
106         (searchRec.Name <> '..') then
107       begin
108         AList.Add(thePath + searchRec.Name);
109         RecurseDirTree(thePath + searchRec.Name + '\', AList);
110         Application.ProcessMessages;
111       end;
112     until
113       FindNext(searchRec) <> 0;
114   finally
115     SysUtils.FindClose(searchRec);
116   end;
117 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.
118 
119 procedure TForm1.ScanDirectory(Path: string; List: TStringList; SubDirFlag: 
120 Boolean);
121 var
122   SearchRec: TSearchRec;
123   Ext: string;
124 begin
125   if Path[Length(Path)] <> '\' then
126     Path := Path + '\';
127   if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 then
128   begin
129     repeat
130       if SearchRec.Attr = faDirectory then
131       begin
132         if SubDirFlag and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
133           ScanDirectory(Path + SearchRec.Name, List, SubDirFlag);
134       end
135       else
136       begin
137         Ext := UpperCase(ExtractFileExt(SearchRec.Name));
138         if (Ext = '.BMP') then
139         begin
140           List.Add(Path + SearchRec.Name);
141         end;
142       end;
143     until
144       FindNext(SearchRec) <> 0;
145   end;
146 end;
147 
148 /Use it as follows:
149 
150 ScanDirectory(GetCurrentDir, YourStringList, False);



Solve 4:

151 procedure TForm1.Button1Click(Sender: TObject);
152 var
153   SearchRec: TSearchRec;
154 begin
155   if FindFirst('c:\images\*.jpg', faAnyFile, SearchRec) = 0 then
156   try
157     repeat
158       listbox1.items.add(searchrec.name);
159     until
160       Findnext(SearchRec) <> 0;
161   finally
162     FindClose(SearchRec);
163   end;
164 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:
165 
166 function FileExistsExt(const aPath, aFilename: string): Boolean;
167 var
168   DSearchRec: TSearchRec;
169 begin
170   Result := FileExists(IncludeTrailingPathDelimiter(aPath) + aFilename);
171   if not Result then
172   begin
173     if FindFirst(APath + '\*', faDirectory, DSearchRec) = 0 then
174     begin
175       repeat
176         if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
177           Result := FileExistsExt(IncludeTrailingPathDelimiter(aPath) +
178 					 DSearchRec.Name, aFilename);
179       until
180         FindNext(DSearchRec) <> 0;
181     end;
182     FindClose(DSearchRec);
183   end;
184 end;
185 
186 //Usage:
187 
188 { ... }
189 if FileExistsExt('C:', 'Testfile.dat') then
190   { ... }



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. 

191 interface
192 
193 function FindFile(const filespec: TFileName; attributes: integer
194   = faReadOnly or faHidden or faSysFile or faArchive): TStringList;
195 
196 implementation
197 
198 function FindFile(const filespec: TFileName;
199   attributes: integer): TStringList;
200 var
201   spec: string;
202   list: TStringList;
203 
204   procedure RFindFile(const folder: TFileName);
205   var
206     SearchRec: TSearchRec;
207   begin
208     // Locate all matching files in the current
209     // folder and add their names to the list
210     if FindFirst(folder + spec, attributes, SearchRec) = 0 then
211     begin
212       try
213         repeat
214           if (SearchRec.Attr and faDirectory = 0) or
215             (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
216             list.Add(folder + SearchRec.Name);
217         until FindNext(SearchRec) <> 0;
218       except
219         FindClose(SearchRec);
220         raise;
221       end;
222       FindClose(SearchRec);
223     end;
224     // Now search the subfolders
225     if FindFirst(folder + '*', attributes
226       or faDirectory, SearchRec) = 0 then
227     begin
228       try
229         repeat
230           if ((SearchRec.Attr and faDirectory) <> 0) and
231             (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
232             RFindFile(folder + SearchRec.Name + '\');
233         until FindNext(SearchRec) <> 0;
234       except
235         FindClose(SearchRec);
236         raise;
237       end;
238       FindClose(SearchRec);
239     end;
240   end; // procedure RFindFile inside of FindFile
241 
242 begin // function FindFile
243   list := TStringList.Create;
244   try
245     spec := ExtractFileName(filespec);
246     RFindFile(ExtractFilePath(filespec));
247     Result := list;
248   except
249     list.Free;
250     raise;
251   end;
252 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: 

253 procedure TForm1.Button1Click(Sender: TObject);
254 var
255   list: TStringList;
256 begin
257   list := FindFile('C:\Delphi\*.pas');
258   ListBox1.Items.Assign(list);
259   list.Free;
260 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. 

261 type
262   PRecInfo = ^TRecInfo;
263   Trecinfo = record
264     prev: PRecInfo;
265     fpathname: string;
266     srchrec: Tsearchrec;
267   end;
268 
269 function TForm1.RecurseDirectory1(fname: string): tstringlist;
270 var
271   f1, f2: Tsearchrec;
272   p1, tmp: PRecInfo;
273   fwc: string;
274   fpath: string;
275   fbroke1, fbroke2: boolean;
276 begin
277   result := tstringlist.create;
278   fpath := extractfilepath(fname);
279   fwc := extractfilename(fname);
280   new(p1);
281   p1.fpathname := fpath;
282   p1.prev := nil;
283   fbroke1 := false;
284   fbroke2 := false;
285   while (p1 <> nil) do
286   begin
287     if (fbroke1 = false) then
288       if (fbroke2 = false) then
289       begin
290         if (findfirst(fpath + '*', faAnyfile, f1) <> 0) then
291           break;
292       end
293       else if (findnext(f1) <> 0) then
294       begin
295         repeat
296           findclose(f1);
297           if (p1 = nil) then
298             break;
299           fpath := p1.fpathname;
300           f1 := p1.srchrec;
301           tmp := p1.prev;
302           dispose(p1);
303           p1 := tmp;
304         until (findnext(f1) = 0);
305         if (p1 = nil) then
306           break;
307       end;
308     if ((f1.Name <> '.') and (f1.name <> '..') and ((f1.Attr and fadirectory) =
309       fadirectory)) then
310     begin
311       fbroke1 := false;
312       new(tmp);
313       with tmp^ do
314       begin
315         fpathname := fpath;
316         srchrec.Time := f1.time;
317         srchrec.Size := f1.size;
318         srchrec.Attr := f1.attr;
319         srchrec.Name := f1.name;
320         srchrec.ExcludeAttr := f1.excludeattr;
321         srchrec.FindHandle := f1.findhandle;
322         srchrec.FindData := f1.FindData;
323       end;
324       tmp.prev := p1;
325       p1 := tmp;
326       fpath := p1.fpathname + f1.name + '\';
327       if findfirst(fpath + fwc, faAnyfile, f2) = 0 then
328       begin
329         result.add(fpath + f2.Name);
330         while (findnext(f2) = 0) do
331           result.add(fpath + f2.Name);
332         findclose(f2);
333       end;
334       fbroke2 := false;
335     end
336     else
337     begin
338       if (findnext(f1) <> 0) then
339       begin
340         findclose(f1);
341         fpath := p1.fpathname;
342         f1 := p1.srchrec;
343         fbroke1 := false;
344         fbroke2 := true;
345         tmp := p1.prev;
346         dispose(p1);
347         p1 := tmp;
348       end
349       else
350       begin
351         fbroke1 := true;
352         fbroke2 := false;
353       end;
354     end;
355   end;
356   fpath := extractfilepath(fname);
357   if findfirst(fname, faAnyfile, f1) = 0 then
358   begin
359     result.add(fpath + f2.Name);
360     while (findnext(f1) = 0) do
361       result.add(fpath + f2.Name);
362     findclose(f1);
363   end;
364 end;


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC