Ir para conteúdo
Fórum CódigoFonte.net
Entre para seguir isso  
gleury

Fazendo um busca de arquivo em TODO O HD

Recommended Posts

Preciso de uma rotina que encontre uma arquivo localizado dentro do meu HD. por exemplo so vou passar o nome do arquivo ex: 'Inicio.txt', como se fosse a pesquisa do windows, so passo o nome do arquivo e retorna o caminho do mesmo.

Como posso fa zer um busca de arquivo EM TODO O HD?

Eu dei uma busca na internet e encontrei essa rotina:

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;

Essa Rotina fucionou pefeitamente bem, porém ela só fuciona no windows XP e eu queria que fucionasse também no WINDOWS 7.

Espero q vocês mi ajudem.

Obrigado...

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar Agora
Entre para seguir isso  

×
×
  • Criar Novo...