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