Necesito un "explorador"

[luppus]

Hola a todos,
necesito un programa que sea como el explorador de windows pero no puedo utilizar ese, así que me vale uno parecido aunque sea más reducido.
Lo que necesito que haga es:
- Navegar por directorios y subdirectorios
- La opción buscar
- Ejecutar cualquier fichero cliceandolo

[moche_67]

Usa le windows commander o bueno kreo ke ahora se llama Total Commander... search it..¡¡¡

[Kenshin]

Haber si te sirve este pequeño codigo




Option Explicit
Dim SearchFlag As Integer ' Se usa como indicador para cancelar y otras operaciones.

Private Sub cmdExit_Click()
If cmdExit.Caption = "&Salir" Then
End
Else ' Si el usuario eligió Cancelar, termina la búsqueda.
SearchFlag = False
End If
End Sub

Private Sub cmdSearch_Click()
' Inicializa la búsqueda y después realiza una búsqueda recursiva.
Dim FirstPath As String, DirCount As Integer, NumFiles As Integer
Dim result As Integer
' Comprueba lo que hizo el usuario en último lugar.
If cmdSearch.Caption = "&Volver" Then ' Si es restablecer, inicializa y sale.
ResetSearch
txtSearchSpec.SetFocus
Exit Sub
End If

' Actualiza dirList.Path si es distinto del directorio seleccionado
' actualmente; de lo contrario, realiza la búsqueda.
If dirList.Path <> dirList.List(dirList.ListIndex) Then
dirList.Path = dirList.List(dirList.ListIndex)
Exit Sub ' Sale de forma que el usuario pueda mirar antes de buscar.
End If

' Continúa con la búsqueda.
Picture2.Move 0, 0
Picture1.Visible = False
Picture2.Visible = True

cmdExit.Caption = "Cancelar"

filList.Pattern = txtSearchSpec.Text
FirstPath = dirList.Path
DirCount = dirList.ListCount

' Inicia la búsqueda recursiva de directorios.
NumFiles = 0 ' Restablece el indicador de archivos encontrados.
result = DirDiver(FirstPath, DirCount, "")
filList.Path = dirList.Path
cmdSearch.Caption = "&Volver"
cmdSearch.SetFocus
cmdExit.Caption = "&Salir"
End Sub

Private Function DirDiver(NewPath As String, DirCount As Integer, BackUp As String) As Integer
' Busca recursivamente en directorios desde NewPath hacia abajo...
' Se busca en NewPath en este paso recursivo.
' BackUp es el origen de este paso recursivo.
' DirCount es el número de subdirectorios de este directorio.
Static FirstErr As Integer
Dim DirsToPeek As Integer, AbandonSearch As Integer, ind As Integer
Dim OldPath As String, ThePath As String, entry As String
Dim retval As Integer
SearchFlag = True ' Establece el indicador de modo que el usuario pueda interrumpir.
DirDiver = False ' Lo establece a True si hay un error.
retval = DoEvents() ' Comprueba si hay eventos (por ejemplo, si el usuario elige Cancelar).
If SearchFlag = False Then
DirDiver = True
Exit Function
End If
On Local Error GoTo DirDriverHandler
DirsToPeek = dirList.ListCount ' ¿Cuántos directorios hay debajo de éste?
Do While DirsToPeek > 0 And SearchFlag = True
OldPath = dirList.Path ' Guarda la ruta de acceso anterior para el próximo paso recursivo.
dirList.Path = NewPath
If dirList.ListCount > 0 Then
' Obtiene hasta la parte inferior del nodo.
dirList.Path = dirList.List(DirsToPeek - 1)
AbandonSearch = DirDiver((dirList.Path), DirCount%, OldPath)
End If
' Sube un nivel en los directorios.
DirsToPeek = DirsToPeek - 1
If AbandonSearch = True Then Exit Function
Loop
' Llama a una función para enumerar archivos.
If filList.ListCount Then
If Len(dirList.Path) <= 3 Then ' Comprueba 2 bytes/carácter
ThePath = dirList.Path ' Si está a nivel raíz, lo deja como está...
Else
ThePath = dirList.Path + "\" ' De lo contrario, pone "\" delante del nombre de archivo.
End If
For ind = 0 To filList.ListCount - 1 ' Agrega archivos de este directorio al cuadro de lista.
entry = ThePath + filList.List(ind)
lstFoundFiles.AddItem entry
lblCount.Caption = Str(Val(lblCount.Caption) + 1)
Next ind
End If
If BackUp <> "" Then ' Si hay un directorio superior, va a este directorio.
dirList.Path = BackUp
End If
Exit Function
DirDriverHandler:
If Err = 7 Then ' Si se produce un error por falta de memoria, supone que el cuadro de lista se llenó.
DirDiver = True ' Crea el mensaje y establece el valor de retorno AbandonSearch.
MsgBox "Se ha llenado el cuadro de lista. Abandonando la búsqueda..."
Exit Function ' Observe que el procedimiento de salida restablece Err a 0.
Else ' De lo contrario, muestra un mensaje de error y sale.
MsgBox Error
End
End If
End Function

Private Sub DirList_Change()
' Actualiza el cuadro de lista de archivos para sincronizar con el cuadro de lista de directorios.
filList.Path = dirList.Path
End Sub

Private Sub DirList_LostFocus()
dirList.Path = dirList.List(dirList.ListIndex)
End Sub

Private Sub DrvList_Change()
On Error GoTo DriveHandler
dirList.Path = drvList.Drive
Exit Sub

DriveHandler:
drvList.Drive = dirList.Path
Exit Sub
End Sub

Private Sub Form_Load()
Picture2.Move 0, 0
Picture2.Width = WinSeek.ScaleWidth
Picture2.BackColor = WinSeek.BackColor
lblCount.BackColor = WinSeek.BackColor
lblCriteria.BackColor = WinSeek.BackColor
lblfound.BackColor = WinSeek.BackColor
Picture1.Move 0, 0
Picture1.Width = WinSeek.ScaleWidth
Picture1.BackColor = WinSeek.BackColor
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub ResetSearch()
' Reinicializa antes de iniciar una nueva búsqueda.
lstFoundFiles.Clear
lblCount.Caption = 0
SearchFlag = False ' Indicador de que hay una búsqueda en curso.
Picture2.Visible = False
cmdSearch.Caption = "&Buscar"
cmdExit.Caption = "&Salir"
Picture1.Visible = True
dirList.Path = CurDir: drvList.Drive = dirList.Path ' Restablece la ruta de acceso.
End Sub

Private Sub txtSearchSpec_Change()
' Actualiza el cuadro de lista de archivos si el usuario cambia el modelo.
filList.Pattern = txtSearchSpec.Text
End Sub

Private Sub txtSearchSpec_GotFocus()
txtSearchSpec.SelStart = 0 ' Resalta la entrada actual.
txtSearchSpec.SelLength = Len(txtSearchSpec.Text)
End Sub