Underc0de

Programación General => Visual Basic => Códigos Fuentes => Mensaje iniciado por: Juan en Febrero 27, 2011, 05:47:05 PM

Título: File Manager
Publicado por: Juan en Febrero 27, 2011, 05:47:05 PM
Bueno, este es un simple modulo con el que puedes obtener los archivos y direcctorios de una ruta y tambien enumerar los discos.  El código esta creado por mi.

Código (vb) [Seleccionar]
Option Explicit
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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long

Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Const MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1

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

Public Function Unidades() As String
    Dim Retorno As Long
    Dim i As Long
    Dim Discos As String

    Retorno = GetLogicalDrives

    For i = 0 To 25
        If (Retorno And 2 ^ i) <> 0 Then
            Discos = Discos & "%%%%" & Chr$(65 + i)
         End If
    Next i

    Unidades = Discos
End Function

Public Function Nulos(Cadena As String) As String
    If InStr(Cadena, Chr(0)) <> 0 Then
        Cadena = Left(Cadena, InStr(Cadena, Chr(0)) - 1)
    End If
    Nulos = Cadena
End Function

Public Function Archivos(Ruta As String) As String
    Dim WFD As WIN32_FIND_DATA
    Dim Inicio As Long
    Dim Seguimos As Long
    Dim ListaArchivos As String

    Inicio = FindFirstFile(Ruta & "*", WFD)
    If Inicio = INVALID_HANDLE_VALUE Then
        Exit Function
    End If

    Seguimos = True

    Do While Seguimos
        If GetFileAttributes(Ruta & WFD.cFileName) = FILE_ATTRIBUTE_DIRECTORY Then
            ListaArchivos = ListaArchivos & Nulos(WFD.cFileName)
            ListaArchivos = ListaArchivos & "$$$$DIREC####"' si es un directorio se añade $$$$DIREC
        Else
            ListaArchivos = ListaArchivos & Nulos(WFD.cFileName)
            ListaArchivos = ListaArchivos & "####"

        End If
        Seguimos = FindNextFile(Inicio, WFD)
    Loop

    FindClose Inicio

    Archivos = ListaArchivos
End Function


salu2!