Truco: Buscar ficheros y/o carpetas…

Hola a todos, aquí les dejo un código que busca carpetas y/o ficheros:

procedure BuscaFicheros(path, mask : AnsiString; var Value : TStringList; brec : Boolean);
var
srRes : TSearchRec;
iFound : Integer;
I : Integer;
begin
I := 0;
if ( brec ) then
begin
if path[Length(path)] <> ‘\’ then path := path +’\';
iFound := FindFirst( path + ‘*.*’, faAnyfile, srRes );
while iFound = 0 do
begin
if ( srRes.Name <> ‘.’ ) and ( srRes.Name <> ‘..’ ) then
if srRes.Attr and faDirectory > 0 then
BuscaFicheros( path + srRes.Name, mask, Value, brec );
iFound := FindNext(srRes);
end;
FindClose(srRes);
end;
if path[Length(path)] <> ‘\’ then path := path +’\';
iFound := FindFirst(path+mask, faAnyFile-faDirectory, srRes);
while iFound = 0 do
begin
if ( srRes.Name <> ‘.’ ) and ( srRes.Name <> ‘..’ ) and ( srRes.Name <> ” ) then
Begin
For I := 1 To Length(Path) Do
If Path[I] = ‘\’ Then Path[I] := ‘-’;
If Value.IndexOf(Copy(Path,11,Length(Path))) = -1 Then Value.Add(Copy(Path, 11,Length(Path)));
End;
iFound := FindNext(srRes);
end;
FindClose( srRes );
end;

Añadimos a nuestra aplicación un MEMO y un botón, en el evento OnClick del botón escribimos lo siguiente:

procedure TForm1.Button1Click(Sender: TObject);
var
Ficheros:TStringList;
begin
Memo1.Clear;
Ficheros := TStringList.Create;
BuscaFicheros(‘c:\’,'*.*’,Ficheros,TRUE); //podemos cambiar el path y las extensiones de los ficheros a buscar…
Memo1.Lines.Assign(Ficheros);
Memo1.Lines.SaveToFile(‘Busqueda.txt’); //Si queremos salvar los resultados de la búsqueda…
MessageDlg(‘Se encontró un total de: ‘ + IntToStr(Ficheros.Count) + ‘ carpetas’, mtInformation, [mbOK],0);
Ficheros.Free;
end;

Salu2,

Lester Espinosa Martínez