Author: Tomas Rutkauskas
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.}
1 private
2 { Private declarations }
3 FScanAborted: Boolean;
4 public
5 { Public declarations }
6
7 function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
8
9 function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean;
10
11 function ScanDirectory(var path: string): Boolean;
12 var
13 SRec: TSearchRec;
14 pathlen: Integer;
15 res: Integer;
16 begin
17 label1.caption := path;
18 pathlen := Length(path);
19 { first pass, files }
20 res := FindFirst(path + filemask, faAnyfile, SRec);
21 if res = 0 then
22 try
23 while res = 0 do
24 begin
25 hitlist.Add(path + SRec.Name);
26 res := FindNext(SRec);
27 end;
28 finally
29 FindClose(SRec)
30 end;
31 Application.ProcessMessages;
32 Result := not (FScanAborted or Application.Terminated);
33 if not Result then
34 Exit;
35 {second pass, directories}
36 res := FindFirst(path + ' *.* ', faDirectory, SRec);
37 if res = 0 then
38 try
39 while (res = 0) and Result do
40 begin
41 if ((Srec.Attr and faDirectory) = faDirectory) and (Srec.name <> ' . ')
42 and (Srec.name <> ' .. ') then
43 begin
44 path := path + SRec.name + '\';
45 Result := ScanDirectory(path);
46 SetLength(path, pathlen);
47 end;
48 res := FindNext(SRec);
49 end;
50 finally
51 FindClose(SRec)
52 end;
53 end;
54
55 begin
56 FScanAborted := False;
57 Screen.Cursor := crHourglass;
58 try
59 Result := ScanDirectory(root);
60 finally
61 Screen.Cursor := crDefault
62 end;
63 end;
64
65 procedure TForm1.Button2Click(Sender: TObject);
66 var
67 ch: Char;
68 root: string;
69 begin
70 root := 'C:\';
71 for ch := 'A' to 'Z' do
72 begin
73 root[1] := ch;
74 case GetDriveType(Pchar(root)) of
75 DRIVE_FIXED, DRIVE_REMOTE:
76 if not ScanDrive(root, edit1.text, listbox1.items) then
77 Break;
78 end;
79 end;
80 end;
81
82 procedure TForm1.Button3Click(Sender: TObject);
83 begin {aborts scan}
84 fScanAborted := True;
85 end;
Solve 2:
86
87 procedure TFrmRecurseDirTree.RecurseDirTree(APath: string; AList: TStrings);
88 var
89 searchRec: TSearchRec;
90 thePath: string;
91 begin
92 if (Length(thePath) > 0) then
93 Exit;
94 {Riffle through the subdirectories and find the file(s) there}
95 thePath := APath;
96 if (thePath[Length(thePath)] <> '\') then
97 thePath := thePath + '\';
98 if FindFirst(thePath + '*.*', faDirectory, searchRec) = 0 then
99 try
100 repeat
101 if (searchRec.Attr and faDirectory > 1) and (searchRec.Name <> '.') and
102 (searchRec.Name <> '..') then
103 begin
104 AList.Add(thePath + searchRec.Name);
105 RecurseDirTree(thePath + searchRec.Name + '\', AList);
106 Application.ProcessMessages;
107 end;
108 until
109 FindNext(searchRec) <> 0;
110 finally
111 SysUtils.FindClose(searchRec);
112 end;
113 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.
114
115 procedure TForm1.ScanDirectory(Path: string; List: TStringList; SubDirFlag:
116 Boolean);
117 var
118 SearchRec: TSearchRec;
119 Ext: string;
120 begin
121 if Path[Length(Path)] <> '\' then
122 Path := Path + '\';
123 if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 then
124 begin
125 repeat
126 if SearchRec.Attr = faDirectory then
127 begin
128 if SubDirFlag and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
129 ScanDirectory(Path + SearchRec.Name, List, SubDirFlag);
130 end
131 else
132 begin
133 Ext := UpperCase(ExtractFileExt(SearchRec.Name));
134 if (Ext = '.BMP') then
135 begin
136 List.Add(Path + SearchRec.Name);
137 end;
138 end;
139 until
140 FindNext(SearchRec) <> 0;
141 end;
142 end;
Use it as follows:
ScanDirectory(GetCurrentDir, YourStringList, False);
Solve 4:
143
144 procedure TForm1.Button1Click(Sender: TObject);
145 var
146 SearchRec: TSearchRec;
147 begin
148 if FindFirst('c:\images\*.jpg', faAnyFile, SearchRec) = 0 then
149 try
150 repeat
151 listbox1.items.add(searchrec.name);
152 until
153 Findnext(SearchRec) <> 0;
154 finally
155 FindClose(SearchRec);
156 end;
157 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:
158
159 function FileExistsExt(const aPath, aFilename: string): Boolean;
160 var
161 DSearchRec: TSearchRec;
162 begin
163 Result := FileExists(IncludeTrailingPathDelimiter(aPath) + aFilename);
164 if not Result then
165 begin
166 if FindFirst(APath + '\*', faDirectory, DSearchRec) = 0 then
167 begin
168 repeat
169 if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
170 Result := FileExistsExt(IncludeTrailingPathDelimiter(aPath) +
171 DSearchRec.Name, aFilename);
172 until
173 FindNext(DSearchRec) <> 0;
174 end;
175 FindClose(DSearchRec);
176 end;
177 end;
178
179 Usage:
180
181 { ... }
182 if FileExistsExt('C:', 'Testfile.dat') then
183 { ... }
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.
184 interface
185
186 function FindFile(const filespec: TFileName; attributes: integer
187 = faReadOnly or faHidden or faSysFile or faArchive): TStringList;
188
189 implementation
190
191 function FindFile(const filespec: TFileName;
192 attributes: integer): TStringList;
193 var
194 spec: string;
195 list: TStringList;
196
197 procedure RFindFile(const folder: TFileName);
198 var
199 SearchRec: TSearchRec;
200 begin
201 // Locate all matching files in the current
202 // folder and add their names to the list
203 if FindFirst(folder + spec, attributes, SearchRec) = 0 then
204 begin
205 try
206 repeat
207 if (SearchRec.Attr and faDirectory = 0) or
208 (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
209 list.Add(folder + SearchRec.Name);
210 until FindNext(SearchRec) <> 0;
211 except
212 FindClose(SearchRec);
213 raise;
214 end;
215 FindClose(SearchRec);
216 end;
217 // Now search the subfolders
218 if FindFirst(folder + '*', attributes
219 or faDirectory, SearchRec) = 0 then
220 begin
221 try
222 repeat
223 if ((SearchRec.Attr and faDirectory) <> 0) and
224 (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
225 RFindFile(folder + SearchRec.Name + '\');
226 until FindNext(SearchRec) <> 0;
227 except
228 FindClose(SearchRec);
229 raise;
230 end;
231 FindClose(SearchRec);
232 end;
233 end; // procedure RFindFile inside of FindFile
234
235 begin // function FindFile
236 list := TStringList.Create;
237 try
238 spec := ExtractFileName(filespec);
239 RFindFile(ExtractFilePath(filespec));
240 Result := list;
241 except
242 list.Free;
243 raise;
244 end;
245 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:
246 procedure TForm1.Button1Click(Sender: TObject);
247 var
248 list: TStringList;
249 begin
250 list := FindFile('C:\Delphi\*.pas');
251 ListBox1.Items.Assign(list);
252 list.Free;
253 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.
254 type
255 PRecInfo = ^TRecInfo;
256 Trecinfo = record
257 prev: PRecInfo;
258 fpathname: string;
259 srchrec: Tsearchrec;
260 end;
261
262 function TForm1.RecurseDirectory1(fname: string): tstringlist;
263 var
264 f1, f2: Tsearchrec;
265 p1, tmp: PRecInfo;
266 fwc: string;
267 fpath: string;
268 fbroke1, fbroke2: boolean;
269 begin
270 result := tstringlist.create;
271 fpath := extractfilepath(fname);
272 fwc := extractfilename(fname);
273 new(p1);
274 p1.fpathname := fpath;
275 p1.prev := nil;
276 fbroke1 := false;
277 fbroke2 := false;
278 while (p1 <> nil) do
279 begin
280 if (fbroke1 = false) then
281 if (fbroke2 = false) then
282 begin
283 if (findfirst(fpath + '*', faAnyfile, f1) <> 0) then
284 break;
285 end
286 else if (findnext(f1) <> 0) then
287 begin
288 repeat
289 findclose(f1);
290 if (p1 = nil) then
291 break;
292 fpath := p1.fpathname;
293 f1 := p1.srchrec;
294 tmp := p1.prev;
295 dispose(p1);
296 p1 := tmp;
297 until (findnext(f1) = 0);
298 if (p1 = nil) then
299 break;
300 end;
301 if ((f1.Name <> '.') and (f1.name <> '..') and ((f1.Attr and fadirectory) =
302 fadirectory)) then
303 begin
304 fbroke1 := false;
305 new(tmp);
306 with tmp^ do
307 begin
308 fpathname := fpath;
309 srchrec.Time := f1.time;
310 srchrec.Size := f1.size;
311 srchrec.Attr := f1.attr;
312 srchrec.Name := f1.name;
313 srchrec.ExcludeAttr := f1.excludeattr;
314 srchrec.FindHandle := f1.findhandle;
315 srchrec.FindData := f1.FindData;
316 end;
317 tmp.prev := p1;
318 p1 := tmp;
319 fpath := p1.fpathname + f1.name + '\';
320 if findfirst(fpath + fwc, faAnyfile, f2) = 0 then
321 begin
322 result.add(fpath + f2.Name);
323 while (findnext(f2) = 0) do
324 result.add(fpath + f2.Name);
325 findclose(f2);
326 end;
327 fbroke2 := false;
328 end
329 else
330 begin
331 if (findnext(f1) <> 0) then
332 begin
333 findclose(f1);
334 fpath := p1.fpathname;
335 f1 := p1.srchrec;
336 fbroke1 := false;
337 fbroke2 := true;
338 tmp := p1.prev;
339 dispose(p1);
340 p1 := tmp;
341 end
342 else
343 begin
344 fbroke1 := true;
345 fbroke2 := false;
346 end;
347 end;
348 end;
349 fpath := extractfilepath(fname);
350 if findfirst(fname, faAnyfile, f1) = 0 then
351 begin
352 result.add(fpath + f2.Name);
353 while (findnext(f1) = 0) do
354 result.add(fpath + f2.Name);
355 findclose(f1);
356 end;
357 end;
|
