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
'*********************************************************
Contactar Última actualización 19/09/2003     © Juan M. Afán deRibera