Como eu crio uma Rotina de Pesquisa que encontre um arquivo?

20/05/2003

1

Alguem sabe com fazer isto?


Responder

Posts

20/05/2003

Osmar Cardoso

Use a função Locate!


Responder

20/05/2003

Rosivaldo

Procure na ajuda do delphi por [b:98233f53f1]TSearchRec[/b:98233f53f1]

Tem uma bom exemplo lá!


Responder

20/05/2003

Carnette

[quote:15f3dfed2d=´Rodrigo Ferreira´]Alguem sabe com fazer isto?[/quote:15f3dfed2d]

Procurando um arquivo em todo o HD
interface

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


implememtation

function TForm1.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;

//Chame a funcao deste jeito:

procedure TForm1.Button1Click(Sender: TObject);
var
l1:Tstringlist;
begin
l1:=tstringlist.create;
listbox1.items.clear;
listbox1.Items.BeginUpdate;
l1:=recursedirectory1(´C:\*.exe´);
listbox1.items.assign(l1);
freeandnil(l1);
listbox1.Items.endUpdate;
end;


Responder
Valeu :wink:


Responder
×
+1 DevUP
Acesso diário, +1 DevUP
Parabéns, você está investindo na sua carreira