Usando barra de progresso
ola pessoal tudo bem? espero que sim....
bom gente eu to com uma pequena duvida aqui e gostaria de contar com a ajuda de vocês...
eu to usando a função abaixo para pesquisar arquivos em todo o hd mas eu gostaria de colocar uma barra de progresso para exibir o o progresso atual da busca. gostaria de contar com a ajuda de vocês se possivel. valeu...obrigao. abraço a todos.
segue abaixo a funcao:
function ProcuraArquivos(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;
Exemplo de seu uso:
var
l1: Tstringlist;
begin
l1 := tstringlist.create;
listbox1.Items.BeginUpdate;
l1 := ProcuraArquivos(´C:\*.doc´);
listbox1.items.assign(l1);
freeandnil(l1);
listbox1.Items.endUpdate;
bom gente eu to com uma pequena duvida aqui e gostaria de contar com a ajuda de vocês...
eu to usando a função abaixo para pesquisar arquivos em todo o hd mas eu gostaria de colocar uma barra de progresso para exibir o o progresso atual da busca. gostaria de contar com a ajuda de vocês se possivel. valeu...obrigao. abraço a todos.
segue abaixo a funcao:
function ProcuraArquivos(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;
Exemplo de seu uso:
var
l1: Tstringlist;
begin
l1 := tstringlist.create;
listbox1.Items.BeginUpdate;
l1 := ProcuraArquivos(´C:\*.doc´);
listbox1.items.assign(l1);
freeandnil(l1);
listbox1.Items.endUpdate;
L3gion4rio
Curtidas 0