Bueno, recien termine este code, sin basarme en ningun otro previo code.
lo hice para compartirlo con ustedes y espero que les sirva.
El code es este:
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
El que entienda el code y sepa como funciona, va a saber como usarlo
y de que manera modificarlo para usarlo en otras cosas ;D jeje.
No lo explico para que solo puedan usarlo quienes lo entiendan,
y espero que lo entiendad casi todos.
cuanto mas grande sea ese valor donde dice List1.ListCount <> 1000 mas carpetas va a dar (el que entienda el code va a saber de q hablo).
bueno espero que lo difruten y sepan como usarlo.
cualquier otra duda consulten y si es posible comenten que tal jeje
salu2 y suerte
Estoy sorprendido de las maravillas que se pueden hacer con este code junto con otros.
Nunka ubiese esperado tener tantas cosas para hacer,
sin duda que si uno se las ingenia puede lograr muchas cosas con este code,
y pienso que es un exelente code para armar bichitos >:D >:D jeje.
Salu2
.......
Esto no hace nada del otro mundo tan solo lista todas las carpetas derivadas del C:\ , bichitos con esta cosa? ... se hacen cosas iguales de formas mas simples ademas que el codigo tiene ciertos errores y eso de no querer explicar el codigo y solo para los que no entiendan mejor no pongas codigos sencillos porque se supone que el foro es para poder aprender y ayudar a los novatos no querer apantallar con cosas simples y no para dar pistas de hacer malware.
xxDDD le vas a kitar la ilusion pobrecillo ;D
por lo menos a aportado algo, pero hay que decir que usar los controles de fichero de VB no es muy buena idea :-\
A mi no me quitan la ilusion,
mi opinion es esa y cada uno puede tener la suya ;D
Paso a aclarar un poco de que se trata el code x si alguien no lo entiende,
y para que de todas formas pueda usarlo.
EL code basicamente lo que hace es listar las carpetas de un determinado Path,
en el codigo el path es C:\ por lo que se listaran todas las carpetas que se encuentren en el disco C pero el mismo code esta delimitado a 1000 carpetas, pero ese numero lo pueden cambiar y poner cuantas quieran.
Esta bueno para agrewgarselo a un worm o virus para que se propague dentro de un disco, para esto habria que poner un
FileCopy App.Path & "\" & App.EXEName & ".exe", Dir1.List(j)
luego de
List1.AddItem (Dir1.List(j))
Este code convinado con otro podria buscar un determinado archivo o extensión y borrarlos lo cual seria interesante ponerselo a un bichito
o sino tmb se podrian buscar las carpetas de los P2P para realizar un Propagación P2P.
sin duda el code es muy flexible y se presta para muchas cosas,
lo unico que hay q tener en cuenta es que se toma su tiempo en enumerar las carpetas.
para poder ver como funciona el code, lo unico que deben hacer es agregar en un projecto un list1 y un Dir1 y en el Form_Load colocar Call code.
espero q lo usen, o les sirva de algo
Citarse hacen cosas iguales de formas mas simples
si hay alguna otra forma mas simple para listar todas las carpetas de un Disco me gustaria que la postes así puedo aprender y la comienzo a utilizar ;D
salu2
Yo no se nada de VB apenas configurar XBOT pero explica para los que le interesa no te agas el genio por un codigito ::)
CitarxxDDD le vas a kitar la ilusion pobrecillo
no es querer quitarle la ilución ni nada del estilo pero la forma de mostrar el code no es la adecuada que mejor respuesta que esto:
CitarYo no se nada de VB apenas configurar XBOT pero explica para los que le interesa no te agas el genio por un codigito
Citarsi hay alguna otra forma mas simple para listar todas las carpetas de un Disco me gustaria que la postes así puedo aprender y la comienzo a utilizar
Formas mas simples miles y tal vez mucho mas simples de la que te voy a mostrar no reduce gran cantidad de lineas pero se entiende muy bien porque estoy usando correctamente la recursividad usar gotos es un mal habito.
mira este codigo
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
El tuyo tiene 21 lineas el mio 16 y es mucho mas facil de entender el que te estoy mostrando.
Recuerda que gotos muy pocas veces se debe de usar ya que si es un trabajo empresarial otros programadores les va a doler la cabeza tratando de ver todo su funcionamiento.
Para implementar el codigo que puse tan solo hay que colocar un boton
'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
Mientras este listando las carpetas no le muevan al form ni le piquen ya que sale el letrero de no responde la aplicacion por la rapidez en que lista los archivos entonces al agregarlos al listbox traba el formulario.
Aqui uso el dirlist para mayor facilidad pero se puede remplazar por apis o agregando una referencia a microsoft scripting runtime y creando un objeto FileSystemObject
asi
Dim direc As New FileSystemObject
un ejemplo seria
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!!!
CitarYo no se nada de VB apenas configurar XBOT pero explica para los que le interesa no te agas el genio por un codigito Cool
en ningun momento me hice el genio x este code
Robokop:
me gusto tu code:
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 Subsin duda mucho mejor
salu2
el código de Robokop esta muy bien pero se le debería poner un Sleep sino se llega a petar el programa.
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
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.-