Aplicacion de Busqueda Recursiva de Archivos en Disco

[ecfisa]

Hola darkamerico.

De este modo te devuelve en un sólo TStrings todas las carpetas y archivos cuyo nombre contenga la cadena buscada:

Código Delphi [-]
procedure FindFiles(Folder, StrSearched :string; TS: TStrings);
var
  SR: TSearchRec;
  Found: Boolean;
begin
  Screen.Cursor := crHourGlass;
  try
    Folder:= IncludeTrailingPathDelimiter(Folder);
    if FindFirst(Folder + '*.*', faDirectory, SR) = 0 then
    repeat
      Found:= Pos(UpperCase(StrSearched), UpperCase(SR.Name)) <> 0; // ignora mayúsc./minúsc.
      if ((SR.Attr and fadirectory) = fadirectory) then
      begin
        if(SR.Name <> '.') and (SR.Name <> '..') then
        begin
          if Found then
            TS.Add(Folder + SR.Name );
          FindFiles(Folder + SR.Name, StrSearched, TS)
        end
      end
      else if Found then
        TS.Add(Folder + SR.Name);
    until FindNext(SR) <> 0;
    FindClose(SR);
  finally
    Screen.Cursor := crDefault;
  end;
end;

Ejemplo de uso:

Código Delphi [-]
...
begin
  FindFiles('c:\windows', 'debug', ListBoxOccurs.Items);
...

Si queres almacenar carpetas y archivos en dos TStrings diferentes, basta una pequeña modificación:

Código Delphi [-]
procedure FindFiles(Folder, StrSearched :string; TS1, TS2: TStrings);
var
  SR: TSearchRec;
  Found: Boolean;
begin
  Screen.Cursor := crHourGlass;
  try
    Folder:= IncludeTrailingPathDelimiter(Folder);
    if FindFirst(Folder + '*.*', faDirectory, SR) = 0 then
    repeat
      Found:= Pos(UpperCase(StrSearched), UpperCase(SR.Name)) <> 0; // ignora mayúsc./minúsc.
      if ((SR.Attr and fadirectory) = fadirectory) then
      begin
        if(SR.Name <> '.') and (SR.Name <> '..') then
        begin
          if Found then
            TS1.Add(Folder + SR.Name );
          FindFiles(Folder + SR.Name, StrSearched, TS1, TS2)
        end
      end
      else if Found then
        TS2.Add(Folder + SR.Name);
    until FindNext(SR) <> 0;
    FindClose(SR);
  finally
    Screen.Cursor := crDefault;
  end;
end;

Uso:

Código Delphi [-]
...
begin
  FindFiles('c:\windows', 'system', MemoFolders.Lines, MemoFiles.Lines);
...

Saludos