Aporto un Code

Iniciado por DrakoX, 17 Noviembre 2006, 23:59 PM

0 Miembros y 1 Visitante están viendo este tema.

MazarD

#10
Un Sleep seguirá trabando el programa lo que hay que hacer es poner un DoEvents en medio del bucle.

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



Aquí un código que hice hace tiempo usando directamente la api. Estas apis aceptan mascaras así que tambien sirven para buscar cierto archivo en un directorio directamente desdel sistema. Es un poco mas complicado pero creo que merece la pena aprenderlo para saber moverse sin los controles de vb.


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


Copiar este código en el general y en un boton por ejemplo:

msgbox explorefiles("c:\","*.exe")

o

msgbox explorefiles("c:\","*.*")

Bueno, se entiende.
Saludos

//Modificado:
Me había dejado la recursividad :P
-Learn as if you were to live forever, live as if you were to die tomorrow-

http://www.mazard.info
http://twitter.com/MazarD
irc://irc.freenode.org/elhacker.net

NYlOn

Cita de: WarGhost en 19 Noviembre 2006, 16:45 PM
el código de Robokop esta muy bien pero se le debería poner un Sleep sino se llega a petar el programa.

Con un DoEvents adentro del blucle se arregla :)

Saludos.-