Inicio > Delphi, Trucos > Buscar ficheros en un directorio y guardarlos en un TStringList (recursico)

Buscar ficheros en un directorio y guardarlos en un TStringList (recursico)

Share Button

Función para buscar ficheros en un directorio de forma recursiva.
Devuelve una lista de nombres de fichero encontrados a partir de la carpeta inicial StartDir, que cumplen el patrón especificado por FileMask.

Mediante recursively se indica si se desea
hacer la busqueda en los subdirectorios.

El resultado se devuelve en FilesList (TStringList), que es la lista que se rellena con los nombres de fichero encontrados.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
{: Devuelve una lista de nombres de fichero encontrados a partir 
de la carpeta inicial StartDir, que cumplen el patrón especificado 
por FileMask.Mediante recursively se indica si se desea hacer la
 busqueda en los subdirectorios.
StartDir Carpeta desde la que empezar a buscar.
FileMask Patrón que han de cumplir los ficheros.
Recursively Si hay que continuar la búsqueda en los subdirectorios.
FilesList Lista con los nombres de fichero encontrados.
}
procedure FindFiles(StartDir, FileMask: string; 
                 recursively: boolean; var FilesList: TStringList);
const
  MASK_ALL_FILES = '*.*';
  CHAR_POINT = '.';
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
 
  if (StartDir[length(StartDir)] <> '\') then begin
    StartDir := StartDir + '\';
  end;
 
  // Crear la lista de ficheos en el dir. StartDir (no directorios!)
  IsFound := FindFirst(StartDir + FileMask, 
                  faAnyFile - faDirectory, SR) = 0;
 
  // MIentras encuentre
  while IsFound do begin
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
 
  FindClose(SR);
 
  // Recursivo?
  if (recursively) then begin
    // Build a list of subdirectories
    DirList := TStringList.Create;
    // proteccion
    try
    IsFound := FindFirst(StartDir + MASK_ALL_FILES, 
                   faAnyFile, SR) = 0;
    while IsFound do begin
      if ((SR.Attr and faDirectory) <> 0) and 
          (SR.Name[1] <>  CHAR_POINT) then begin
        DirList.Add(StartDir + SR.Name);
        IsFound := FindNext(SR) = 0;
      end; // if
    end; // while
    FindClose(SR);
    // Scan the list of subdirectories
    for i := 0 to DirList.Count - 1 do begin
      FindFiles(DirList[i], FileMask, recursively, FilesList);
    end;
 
    finally
      DirList.Free;
    end;
  end;
end;
Vota este post
Subscribe
Notify of
guest

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.

4 Comments
Inline Feedbacks
Ver todos los comentarios
MOLE
MOLE
13 years ago

Creo que esta equivocado el codigo
while IsFound do begin
if ((SR.Attr and faDirectory) 0) and
(SR.Name[1] CHAR_POINT) then begin
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end; // if
end; // while

deberia ser:

while IsFound do begin
if ((SR.Attr and faDirectory) 0) and
(SR.Name[1] CHAR_POINT) then begin
DirList.Add(StartDir + SR.Name);
// IsFound := FindNext(SR) = 0;
end; // if
IsFound := FindNext(SR) = 0;
end; // while

ISEKO
9 years ago

El codigo listado esta bien.

ReySS
ReySS
3 years ago

Saludos en el 2020…@MOLE lleva razón…dicha línea debe ir fuera del if…gracias por el código funciona muy bien en Delphi 10.1.

4
0
Would love your thoughts, please comment.x
()
x