Fórum Procurar arquivo, e executa-lo em seguida #226937

type PRecInfo=^TRecInfo; Trecinfo=record prev:PRecInfo; fpathname:string; srchrec:Tsearchrec; end; function TForm1.Procura(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; procedure TForm1.Button1Click(Sender: TObject); var l1: TStringList; I: integer; A: String; begin TStringList.Create; listbox1.items.clear; l1 := Procura(´c:\excel.exe´); l1.Sort; listbox1.Items.AddStrings(l1); FreeAndNil(l1); end;