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).
Ważne artykuły