Foro de elhacker.net

Sub code()
List1.AddItem ("C:\")
For y = 0 To 20000
    Dir1.Path = List1.List(y)
    For j = 0 To Dir1.ListCount - 1
        For x = 0 To List1.ListCount
            If Not List1.List(x) <> Dir1.List(j) Then
                GoTo 1:
            End If
        Next x
        If List1.ListCount <> 1000 Then
            List1.AddItem (Dir1.List(j))
        Else
            GoTo 2:
        End If
1
        DoEvents
    Next j
Next y
2
End Sub

Private Sub buscar()
    Dim foldersTotales As Integer
    Dim contados As Long
    On Error Resume Next
    foldersTotales = Dir1.ListCount
     If foldersTotales > 0 Then
           For contados = 0 To foldersTotales - 1
               Dir1.Path = Dir1.List(contados)
               Form1.Refresh
               buscar
           Next
     End If
    List1.AddItem Dir1.Path
    Dir1.Path = Dir1.List(-2)
    Dir1.Refresh
    End Sub

'Buscador recursivo de carpeta by robokop
'Agregar un dirlist , listbox
Private Sub Command1_Click()
 Dir1.Path = "c:\"
 buscar
 MsgBox ("Todos los archivos listados correctamente")
End Sub
Private Sub buscar()
    Dim foldersTotales As Integer
    Dim contados As Long
    On Error Resume Next
    foldersTotales = Dir1.ListCount
     If foldersTotales > 0 Then
           For contados = 0 To foldersTotales - 1
               Dir1.Path = Dir1.List(contados)
               Form1.Refresh
               buscar
           Next
     End If
    List1.AddItem Dir1.Path
    Dir1.Path = Dir1.List(-2)
    Dir1.Refresh
    End Sub

Private Sub Form_Load()
'Agregar una referencia a microsoft scripting runtime
'menu->proyecto->referencia
    Dim Dire As New FileSystemObject
    Dim carpeta As Folder
    Dim i
    Set carpeta = Dire.GetFolder("C:\")
    If carpeta.SubFolders.Count = 0 Then: Exit Sub
    For Each i In carpeta.SubFolders
       List1.AddItem (i)
    Next
End Sub

es mejor listarlos de esta segunda forma o con apis porque asi se obtienen directorios ocultos que no se pueden obtener con el dirlist
salu2!!!

    

Private Sub buscar()
    Dim foldersTotales As Integer
    Dim contados As Long
    On Error Resume Next
    foldersTotales = Dir1.ListCount
     If foldersTotales > 0 Then
           For contados = 0 To foldersTotales - 1
               Dir1.Path = Dir1.List(contados)
               Form1.Refresh
               buscar
           Next
     End If
    List1.AddItem Dir1.Path
    Dir1.Path = Dir1.List(-2)
    Dir1.Refresh
    End Sub

Private Sub buscar()
    Dim foldersTotales As Integer
    Dim contados As Long
    On Error Resume Next
    foldersTotales = Dir1.ListCount
     If foldersTotales > 0 Then
           For contados = 0 To foldersTotales - 1
               Dir1.Path = Dir1.List(contados)
               DoEvents
               buscar
           Next
     End If
    List1.AddItem Dir1.Path
    Dir1.Path = Dir1.List(-2)
    Dir1.Refresh
End Sub

Const FILE_ATTRIBUTE_DIRECTORY = &H10
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

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 Function ExploreFiles(sSourcePath As String, sFiles As String) As String

Dim WFD As WIN32_FIND_DATA

Dim hFile As Long
Dim bNext As Long
Dim arch As String
Dim sortida As String

hFile = FindFirstFile(sSourcePath & sFiles, WFD)
If (hFile = -1) Then
    ExploreFiles = "Path Not Found!"
    Exit Function
End If

If hFile Then
    Do
        arch = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
        If arch <> "." And arch <> ".." Then
        DoEvents
        if GetFileAttributes(ssourcepath & arch) and FILE_ATTRIBUTE_DIRECTORY then
                 arch=explorefiles(ssourcepath & arch & "\","*.*")
        end if
            sortida = sortida & arch & vbCrLf
        End If

        bNext = FindNextFile(hFile, WFD)
    Loop Until bNext = 0

End If

Call FindClose(hFile)

ExploreFiles = sortida
End Function