nos podrias decir algunos nombres de esos programas que tu dices?
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes MenúPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Option Explicit
Dim SearchFlag As Integer ' Se usa como indicador para cancelar y otras operaciones.
Private Sub CmdEjecutar_Click()
Dim res As Long
res = ShellExecute(Me.hwnd, "Open", lstFoundFiles, "", "", 1)
End Sub
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