Foro de elhacker.net

Option Explicit


'***************************************************************************
'*  Código fuente del módulo bas
'***************************************************************************



'Declaraciones del Api
'------------------------------------------------------------------------------

'Esta función busca el primer archivo de un Dir
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long

'Esta el siguiente archivo o directorio
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

'Esta cierra el Handle de búsqueda
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long


' Constantes
'------------------------------------------------------------------------------

'Constantes de atributos de archivos
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

'Otras constantes
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1


'UDT
'------------------------------------------------------------------------------

'Estructura para las fechas de los archivos
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

'Estructura necesaria para la información de archivos
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


'-----------------------------------------------------------------------
    'Funciones
'-----------------------------------------------------------------------


'Esta función es para formatear los nombres de archivos y directorios. Elimina los CHR(0)
'------------------------------------------------------------------------
Function Eliminar_Nulos(OriginalStr As String) As String
   
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    Eliminar_Nulos = OriginalStr

End Function

'Esta función es la principal que permite buscar _
 los archivos y listarlos en el ListBox


Function FindFilesAPI(Path As String, _
                      SearchStr As String, _
                      FileCount As Long, _
                      DirCount As Long, _
                      ListBox As ListBox)


    Dim FileName As String
    Dim DirName As String
    Dim dirNames() As String
    Dim nDir As Long
    Dim i As Long
    Dim hSearch As Long
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Long


    If Right(Path, 1) <> "\" Then Path = Path & "\"
        ' Buscamos por mas directorios
        nDir = 0
        ReDim dirNames(nDir)
        Cont = True
        hSearch = FindFirstFile(Path & "*", WFD)
            If hSearch <> INVALID_HANDLE_VALUE Then
                Do While Cont
                    DirName = Eliminar_Nulos(WFD.cFileName)
                    ' Ignore the current and encompassing directories.
                    If (DirName <> ".") And (DirName <> "..") Then
                        ' Check for directory with bitwise comparison.
                            If GetFileAttributes(Path & DirName) _
                                And FILE_ATTRIBUTE_DIRECTORY Then
                               
                                dirNames(nDir) = DirName
                                DirCount = DirCount + 1
                                nDir = nDir + 1
                                ReDim Preserve dirNames(nDir)
                           
                            End If
                    End If
                    Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
                Loop
               
                Cont = FindClose(hSearch)
           
            End If

        hSearch = FindFirstFile(Path & SearchStr, WFD)
        Cont = True
        If hSearch <> INVALID_HANDLE_VALUE Then
            While Cont
                FileName = Eliminar_Nulos(WFD.cFileName)
                    If (FileName <> ".") And (FileName <> "..") Then
                        FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) _
                                                                  + WFD.nFileSizeLow
                        FileCount = FileCount + 1
                        ListBox.AddItem Path & FileName
                    End If
                Cont = FindNextFile(hSearch, WFD) ' Get next file
            Wend
        Cont = FindClose(hSearch)
        End If

        ' Si estos son Sub Directorios......
        If nDir > 0 Then

        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(Path & dirNames(i) & "\", _
                                                SearchStr, FileCount, DirCount, ListBox)
        Next i
    End If
End Function

Option Explicit


'***************************************************************************
'*  Controles         : Command1 ( para buscar) _
                        Text1 ( para indicar el Path) _
                        Text2 ( para los archivos, por ejemplo *.txt ) _
                        List1
'***************************************************************************

Private Sub Command1_Click()

    Dim Path As String
    Dim Pattern As String
    Dim FileSize As Currency
    Dim Count_Archivos As Long
    Dim Count_Dir As Long

    Screen.MousePointer = vbHourglass
   
    'Borramos el contenido del List1
    List1.Clear
   
    'Path y archivos a buscar
    Path = Text1.Text
    Pattern = Text2.Text
   
    'Llamamos a la función para buscar y que nos retorne algunos datos
    FileSize = FindFilesAPI(Path, Pattern, _
                            Count_Archivos, _
                            Count_Dir, List1)

    'Mostramos los resultados
   
    'Cantidad de archivos encontrados
    MsgBox Count_Archivos & " Archivos encontrados en " & _
                        Count_Dir + 1 & " Directorios", 64
   
    'Tamaño Total en Bytes de los archivos encontrados
    MsgBox "Tamaño total de los archivos: " & _
            Path & " = " & _
            Format(FileSize, "#,###,###,##0") & " Bytes", 64

    Screen.MousePointer = vbDefault

End Sub



Private Sub Form_Load()
    'Directorio de windows
    Text1.Text = Environ("WinDir")
    'Archivos txt
    Text2.Text = "*.txt"
   
    Command1.Caption = "  >> Buscar "

End Sub

'Redimensiona y posiciona los controles
'--------------------------------------------------------------
Private Sub Form_Resize()
    On Local Error Resume Next
   
    Text1.Move 0, 0, Me.ScaleWidth
    Text2.Move 0, Text1.Top + Text1.Height + 50, Me.ScaleWidth

    List1.Move 0, Text2.Top + 50 + Text2.Height, _
                  Me.ScaleWidth, Me.ScaleHeight - _
                 (Text1.Height + Text2.Height + Command1.Height + 100)

    Command1.Move Me.ScaleWidth - Command1.Width - 50, _
                  Me.ScaleHeight - (Command1.Height + 50)

End Sub