Olá, tente os seguintes comandos.
-------------
procedure Tfrm_BuscaArquivos.btn6Click(Sender: TObject);
begin
mmo1.Clear;
PreencherFileList(FED_Arquivo_Des.Text + '\', lst1.Items);
end;
procedure Tfrm_BuscaArquivos.PreencherFileList(Folder: string; sl: TStrings);
var
Rec: TSearchRec;
begin
if edt2.Text = '' then
Application.MessageBox(PChar('Por favor digite o tipo de arquivo
desejado!'), 'Atenção!', MB_OK + MB_ICONINFORMATION);
// Se marcado faz busca para as subdiretórios
if chkSubpasta.Checked then
begin
p_ListarArquivos(FED_Arquivo_Des.Text + '\', edt2.Text, sl, true, true);
end
else
begin
sl.Clear;
if SysUtils.FindFirst(Folder + edt2.Text, faAnyFile, Rec) = 0 then
try
repeat
if (Rec.Name <> '.') and (Rec.Name <> '..') and (Rec.Name <> '')
then
begin
if chkCaminhoCompleto.Checked then
sl.Add(Folder + rec.Name)
else
sl.Add(rec.Name);
end;
until SysUtils.FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
mmo1.Lines.Add(lst1.Items.Text);
end;
end;
procedure Tfrm_BuscaArquivos.p_ListarArquivos(diretorioInicial, mascara:
string; sl: TStrings; listtotaldir: boolean = false; recursive: boolean = true);
var
i: integer;
listatemp: TStrings;
vls_diretoriodestino: string;
procedure ListarDiretorios(Folder: string; lista: Tstrings);
var
Rec: TSearchRec;
i: integer;
temps: string;
begin
lista.Clear;
if SysUtils.FindFirst(Folder + '*', faDirectory, Rec) = 0 then
try
repeat
lista.Add(rec.Name);
until SysUtils.FindNext(Rec) <> 0;
finally
if lista.count <> 0 then
begin
// deleta o diretorio ..
lista.Delete(1);
// deleta o diretorio .
lista.Delete(0);
i := 0;
//deleta os arquivos isto e fica apenas os diretorios
if lista.count <> 0 then
begin
repeat
Application.ProcessMessages;
temps := lista.Strings[i];
temps := extractfileext(temps);
if temps <> '' then
lista.Delete(i)
else
inc(i);
until i >= lista.Count;
end;
end;
SysUtils.FindClose(Rec);
end;
end;
procedure ListarAtahos(Folder, mask: string; Lista: Tstrings);
var
Rec: TSearchRec;
begin
lista.Clear;
if SysUtils.FindFirst(Folder + mask, faAnyFile, Rec) = 0 then
try
repeat
Application.ProcessMessages;
if (Rec.Name <> '.') and (Rec.Name <> '..') and (Rec.Name <> '')
and (Rec.Name <> ' ') then
begin
if chkCaminhoCompleto.Checked then
lista.Add(Folder + rec.Name)
else
lista.Add(rec.Name);
end;
until SysUtils.FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
end;
procedure AddLIstInOther(ListSource, ListDestino: TStrings);
var
f: integer;
begin
for f := 0 to ListSource.Count - 1 do
begin
Application.ProcessMessages;
ListDestino.Add(ListSource.Strings[f]);
end;
end;
begin
vgl_listtemp := TStringList.Create;
vgl_listtemp2 := TStringList.Create;
vls_diretoriodestino := FED_Arquivo_Des.Text;
listatemp := TStringList.Create;
ListarAtahos(diretorioInicial, mascara, sl);
if lst1.Items.Text <> '' then
mmo1.Lines.Add(lst1.Items.Text);
for i := 1 to mmo1.Lines.Count - 1 do
begin
if mmo1.Lines[i] = '' then
mmo1.Lines.Delete(i);
end;
AddLIstInOther(listatemp, vgl_listtemp2);
if recursive = true then
begin
Application.ProcessMessages;
ListarDiretorios(diretorioInicial, listatemp);
AddLIstInOther(listatemp, vgl_listtemp);
for i := 0 to listatemp.Count - 1 do
begin
Application.ProcessMessages;
p_ListarArquivos(diretorioInicial + listatemp.Strings[i] + '\',
mascara, lst1.Items, listtotaldir, recursive);
end;
end;
Application.ProcessMessages;
listatemp.Free;
end;
--- Em delphi-br@yahoogrupos.com.br, "cas.felippe" <cas.feli...@...> escreveu
>
> Olá pessoal tenho a seguinte duvida preciso colocar em TMemo uma lista de
> visualizção de aqrquivos como no dos em que as pastas e arquivos são
> mostrados na tela como uma lista alguem saberia como fazer?
>
