Búsqueda de archivos

El problema con las rutinas es que no buscan un archivo por extensión sino por nombre pero es bastante simple hacer el cambio apropiado y buscar el archivo que sea por la parte que sea (es decir, mejorando la búsqueda del propio Windows). Vamos allá.

unit Buscador;

interface

uses
  Windows, Forms;

// NOTA: Estos procedimientos son los que permitirán rellenar listados y demás.
         Ver abajo el momento en que se llaman y su modo de uso.
type
  TOnCambiarDisco = procedure(const Disco: string) of object;
  TOnBuscarEntrarDir = procedure(const Dir: string) of object;
  TOnBuscarHallarArch = function(const Dir, Arch: string): Boolean of object;

  function BuscarArchivoEnDisco
  (
     const NombArch,                 { Archivo a buscar }
           DirInicial: string        { Directorio en el que comienza la búsqueda }
     ; FuncDir: TOnBuscarEntrarDir   { Llamada al cambiar de directorio }
     ; FuncArch: TOnBuscarHallarArch { Llamada al hallar el archivo }
  ): string;

  function BuscarArchivoPorDiscos
  (
     const NombArch: string          { Archivo a buscar }
     ; FuncDisco: TOnCambiarDisco    { Llamada al cambiar de disco      }
     ; FuncDir: TOnBuscarEntrarDir   { Llamada al cambiar de directorio }
     ; FuncArch: TOnBuscarHallarArch { Llamada al hallar el archivo     }
  ): string;


implementation


{-----------------------------------------------------------------------------}
{ FUNCIÓN: BuscarArchivoEnDisco(const NombArch, DirInicial: string;           }
{                               FuncDir: TOnBuscarEntrarDir;                  }
{                               FuncArch: TOnBuscarHallarArch                 }
{                              ): string;                                     }
{                                                                             }
{ ACCIÓN : Busca el fichero especificado en el argumento 'NombArch' y,        }
{          si lo encuentra, devuelve la ruta y nombre del archivo.            }
{                                                                             }
{          Si el archivo no se encuentra devuelve una cadena vacía.           }
{                                                                             }
{          La búsqueda comienza en el directorio 'DirInicial' y si es una     }
{          cadena en blanco, en el directorio raíz del disco actual.          }
{-----------------------------------------------------------------------------}
function BuscarArchivoEnDisco(const NombArch, DirInicial: string
           ; FuncDir: TOnBuscarEntrarDir   { Llamada al cambiar de directorio }
           ; FuncArch: TOnBuscarHallarArch { Llamada al hallar el archivo     }
   ): string;
var
   Handle: THandle;
   FindData: TWin32FindData;
   ActualDir: String;
   i: Integer;
begin
   Result := '';
   if (DirInicial = '') then
   begin
      GetDir(0, ActualDir);    { 0 = Disco por defecto }
      ActualDir := ActualDir + '\';  { Directorio raiz }
      SetLength(ActualDir, 3);
   end
   else
      ActualDir := DirInicial;
   { Avisar del cambio de directorio }
   if (Assigned(FuncDir)) then FuncDir(ActualDir);
   { Buscar el archivo en el directorio actual }
   Handle := Windows.FindFirstFile(PChar(ActualDir + NombArch), FindData);
   if (not (INVALID_HANDLE_VALUE = Handle)) then { Archivo encontrado }
   begin
      { 'FuncArh' devolverá 'TRUE' si es válido el archivo y 'FALSE' en caso contrario }
      if ((Assigned(FuncArch)) and
          (not (FuncArch(ActualDir, String(FindData.cFileName)))))
      then
         Result := '' { Esto hará que continúe la búsqueda }
      else
         Result := ActualDir + FindData.cFileName;  { Salida: lo hemos hallado }
   end;
   if ('' = Result) then
   begin
      { El archivo no está en el directorio actual: }
      { buscar en los directorios hijos             }
      Handle := Windows.FindFirstFile(PChar(ActualDir + '*.*'), FindData);
      if (not (INVALID_HANDLE_VALUE = Handle)) then
      begin
         repeat
            {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
            { En el bloque 'if' siguiente sólo se entra ante un directorio.   }
            { No se valora el directorio actual ('.') ni el anterior ('..'):  }
            { en ambos casos 'TRUE = (FindData.cFileName[0] = '.')'           }
            {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
            if ((FILE_ATTRIBUTE_DIRECTORY = (FindData.dwFileAttributes and
                                             FILE_ATTRIBUTE_DIRECTORY))
               and
               (not ('.' = FindData.cFileName[0])))
            then
            begin
               { Crear la cadena completa al directorio de búsqueda }
               ActualDir := ActualDir + FindData.cFileName + '\';
               Result := BuscarArchivoEnDisco(NombArch, ActualDir
                                              , FuncDir
                                              , FuncArch
                         ); { Autollamada }
               if ('' = Result) then { La auto-llamada anterior no lo ha hallado... }
               begin                 { ... pasar al directorio superior }
                  i := Length(ActualDir) - 1;
                  if (i > 0) then
                  begin
                     while (not ('\' = ActualDir[i])) do Dec(i);
                     SetLength(ActualDir, i); { Esto recorta la cadena 'ActualDir' }
                  end;
               end;
            end;
         until ((not ('' = Result)) or (not (Windows.FindNextFile(Handle, FindData))));
         { O se ha hallado (Result <> '') o no hay más archivos (FALSE = FindNextFile()) }
      end;
   end;
   { Esta función cierra 'Handles' válidos o inválidos sin dar error }
   Windows.FindClose(Handle);   { Finalizar la búsqueda actual }
end;

{-----------------------------------------------------------------------------}
{ FUNCIÓN: BuscarArchivoPorDiscos(const NombArch: string;                     }
{                                 FuncDisco: TOnCambiarDisco;                 }
{                                 FuncDir: TOnBuscarEntrarDir;                }
{                                 FuncArch:TOnBuscarHallarArch                }
{                                 ): string;                                  }
{                                                                             }
{ ACCIÓN : Busca el fichero especificado en el parámetro 'NombArch' por todos }
{          los discos accesibles del sistema (disquetes, de red, etc.).       }
{-----------------------------------------------------------------------------}
function BuscarArchivoPorDiscos(const NombArch: string
         ; FuncDisco: TOnCambiarDisco      { Llamada al cambiar de disco      }
         ; FuncDir: TOnBuscarEntrarDir     { Llamada al cambiar de directorio }
         ; FuncArch: TOnBuscarHallarArch   { Llamada al hallar el archivo     }
   ): string;
var
   Disco: array [0..3] of Char;
   i: Integer;
begin
   Disco[1] := ':';
   Disco[2] := '\';
   Disco[3] := #0;
   i := 0;
   repeat
      Disco[0] := Chr(i + Ord('A'));
      Case (Windows.GetDriveType(Disco)) of
         DRIVE_REMOVABLE, { Disquete }
         DRIVE_FIXED,     { Disco fijo }
         DRIVE_REMOTE,    { Disco de red }
         DRIVE_CDROM,     { CD-ROM }
         DRIVE_RAMDISK:   { Disco RAM }
         begin
            { Avisar del cambio de disco }
            if (Assigned(FuncDisco)) then FuncDisco(String(Disco));
            { Buscar el archivo partiendo del raíz del disco actual }
            Result := BuscarArchivoEnDisco(NombArch, String(Disco), FuncDir, FuncArch);
         end;
      end;
      Inc(i);
   until ((not ('' = Result)) or (25 < i));
   { 25 es el número de vueltas máximo: del disco 'A:' al 'Z:' }
end;

end.

Crear una unidad con el nombre BUSCADOR.PAS y pegar el código anterior en ella. Para buscar un archivo por todos los discos accesibles en el sistema se hace:

BuscarArchivoPorDiscos(nombre_archivo, x, y, z);

* ‘nombre_archivo’ es el nombre del fichero a buscar.
* ‘x’ es un procedimiento al que se llamará cuando se pase de un disco a otro y puede ser ‘nil’ si no se desea controlar dicho cambio de disco.
* ‘y’ es un procedimiento al que se llamará cuando se entre en un nuevo directorio. Como antes, si no interesa controlar ese evento, se pasará ‘nil’ en el argumento ‘y’.
* ‘z’ es un procedimiento al que se llamará cuando se encuentre un archivo que tenga el mismo nombre que el pasado en el argumento ‘nombre_archivo’. Puse esto porque, en ocasiones, puede existir en el sistema (en distintas carpetas, claro) un archivo que tenga el mismo nombre que el pasado en ‘nombre_archivo’ pero que no sea el que estamos intentando hallar. La función ‘z’ devolverá ‘true’ si es el que queríamos y la búsqueda finalizará. Si la función ‘z’ devuelve ‘false’ la búsqueda continúa. Si tampoco se desea controlar esto, pasar ‘nil’ en ‘z’. Cuando ‘z’ es ‘nil’ la búsqueda acaba al hallar el primer archivo que tenga por nombre ‘nombre_archivo’.

El resultado de todo ello es que se devuelve el PATH completo, disco incluido, al fichero hallado o una cadena vacía si no se halla.

Como decía antes, no funciona con extensiones sino con nombres completos de ficheros. Pero la modificación para que admita cualquier parte del nombre de un fichero es simple.

El código original tiene parámetros por defecto en todos los argumentos que son de tipo procedimiento (por ejemplo, ‘FuncDisco: TOnCambiarDisco = nil’).

Acabo de eliminar a mano la compilación condicional que hacía que esas funciones fuesen directamente utilizables desde versiones anteriores a Delphi 4 (antes de esa versión de Delphi, Object Pascal no admitía argumentos por defecto).