Mega Code Archive
Find all files in the harddisk without using recursion
<![CDATA[
Title: Find all files in the harddisk without using recursion
Question: How to find files in the harddisk without calling the same function over and over again.
Answer:
Most functions that find files that meet a specific mask (like *.jpg,*.exe etc) use recursion ie these function call themselves over and over again to get
the list of files. Here is a function that does not use recursion to accomplish the result
code
-------------------------------------------------------------------------------
interface
type
PRecInfo=^TRecInfo;
Trecinfo=record
prev:PRecInfo;
fpathname:string;
srchrec:Tsearchrec;
end;
procedure RecurseDirectory(fname:string;alist:tstringlist);
implememtation
procedure RecurseDirectory(fname:string;alist:tstringlist);
var
f1,f2:Tsearchrec;
p1,tmp:PRecInfo;
fwc:string;
fpath:string;
fbroke1,fbroke2:boolean;
begin
if alist=nil then
exit;
fpath:=extractfilepath(fname);
fwc:=extractfilename(fname);
new(p1);
p1.fpathname:=fpath;
p1.prev:=nil;
fbroke1:=false;
fbroke2:=false;
while(p1nil) 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:=f1;
end;
tmp.prev:=p1;
p1:=tmp;
fpath:=p1.fpathname+f1.name+'\';
if findfirst(fpath+fwc,faAnyfile,f2)=0 then
begin
repeat
if (f2.Attr and fadirectory)=0 then
alist.add(fpath+f2.Name);
until(findnext(f2)0);
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
repeat
if (f1.Attr and fadirectory)=0 then
alist.add(fpath+f1.Name);
until(findnext(f1)0);
findclose(f1);
end;
end;
--------------------------------------------------------------------------------
you can call the function as shown below
procedure TForm1.Button1Click(Sender: TObject);
var
l1:Tstringlist;
begin
l1:=tstringlist.create;
listbox1.items.clear;
listbox1.Items.BeginUpdate;
recursedirectory1(edit1.text,l1);
listbox1.items.assign(l1);
freeandnil(l1);
listbox1.Items.endUpdate;
end;
]]>