![]() |
|
![]() |
|
Mostrar el contenido completo de un directorio utilizando el API |
|
![]() Volver |
'********************************************************* ' Función mostrarArchivosAPI ' ' Función que recorre recursivamente un directorio y lista ' todos sus archivos, subdirectorios y los archivos ' contenidos dentro de ellos, mostrándolos en la barra de ' dentro de ellos, mostrándolos en la ' estado de Access. Utiliza el API de Windows. ' ' La función Dir de VB no puede usarse en procedimientos ' recursivos y por tanto no se puede utilizar más que para ' conocer el contenido de un solo directorio ' ' Argumentos ' Ruta: Nombre del directorio a partir del cual se ' empezará a buscar. ' ' Autor: Juan M. Afán de Ribera ' ' Fecha: Mayo 2003 ' 1a. Revisión: Septiembre 2003 ' Private Declare Function FindFirstFile _ Lib "kernel32" _ Alias "FindFirstFileA" _ (ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile _ Lib "kernel32" _ Alias "FindNextFileA" _ (ByVal hFindFile As Long, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose _ Lib "kernel32" _ (ByVal hFindFile As Long) As Long Private Const MAX_PATH = 255 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Function mostrarArchivosAPI(Ruta As String) Dim WFD As WIN32_FIND_DATA Dim hBusca As Long Dim ret As Long Dim nomArchivo As String Dim archivo As String If Right(Ruta, 1) <> "\" Then Ruta = Ruta & "\" hBusca = FindFirstFile(Ruta & "*", WFD) If hBusca <> -1 Then ret = True While ret nomArchivo = ExtraerNulos(WFD.cFileName) If (nomArchivo <> ".") And (nomArchivo _ <> "..") Then If (GetAttr(Ruta & nomArchivo) And _ vbDirectory) = vbDirectory Then If (GetAttr(Ruta & nomArchivo) And _ vbDirectory) = vbDirectory Then mostrarArchivosAPI Ruta & _ nomArchivo & "\" SysCmd acSysCmdSetStatus, _ Ruta & nomArchivo End If Else SysCmd acSysCmdSetStatus, _ Ruta & nomArchivo End If End If ret = FindNextFile(hBusca, WFD) Wend FindClose hBusca SysCmd acSysCmdClearStatus End If End Function Function ExtraerNulos(cad As String) As String If (InStr(cad, Chr(0)) > 0) Then cad = Left(cad, InStr(cad, Chr(0)) - 1) End If ExtraerNulos = cad End Function '********************************************************* |
![]() |
Última actualización 19/09/2003 © Juan M. Afán deRibera |