Fórum Procedure de Pesquisa #212522

var
  Form2: TForm2;

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

implementation


procedure TForm2.Button1Click(Sender: TObject);
var 
l1:Tstringlist; 
begin
   l1:=tstringlist.create;
   listbox1.items.clear;
   listbox1.Items.BeginUpdate;
   l1:=recursedirectory(´D:\*.gif´);
   listbox1.items.assign(l1);
   freeandnil(l1);
   listbox1.Items.endUpdate;
end;

function TForm2.RecurseDirectory(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;