Baja los listados de ejemplo para 16 y 32 bits (shell_2.zip 8.45 KB)
- Cómo saber si un programa ha finalizado (VB4 16 ó 32)
- Cómo saber si un programa ha finalizado (VB3)
- Obtener la etiqueta y número de serie del volumen en VB de 16 bits. También para 32 bits
- Usar Shell para ejecutar una orden del MS-DOS
- Esperar a que un programa termine (incluso si es de MS-DOS) (32 bits)
1.- Cómo saber si un programa ha finalizado (VB4 16 ó 32) (3/Mar)
La razón de "repetir" este truco, es porque parece que no queda demasiado claro. Por tanto voy a dar los ejemplos por separado, con la función en un módulo independiente y ejemplo de cómo usarlo.
Espero que ahora esté mejor explicado y puedas usarlo "sin complicaciones"El tema consiste en lo siguiente, tenemos el procedimiento EjecutarPrograma, el cual recibe tres parámetros:
El Form que hace la llamada
El programa a ejecutar (si es una orden del Command.com, te aconsejo que veas cómo hacerlo, en un truco que viene más abajo)
El nombre de la ventana que debemos chequear para poder cerrarla.Ahora veamos el código, porque parece que también da pereza ver el contenido de los archivos de ejemplo.
El único inconveniente es que las páginas crecen y se hacen más lenta de cargar... bueno no importa cuando vea que tiene más KiloBytes de la cuenta, crearé otra página...'--------------------------------------------------------------- 'Shell_32.bas ( 2/Mar/97) ' 'Módulo para comprobar si una tarea MS-DOS ha finalizado 'y cerrar la ventana asociada. 'Sirve tanto para VB4 o superior de 16 y 32 bits, 'si usas VB3 o anterior, usa el módulo Shell_16.bas ' 'Este código es de libre uso/distribución. '--------------------------------------------------------------- 'Declaraciones Generales Option Explicit Option Compare Text 'Declaraciones del API de 16 y 32 bits (sólo para VB4 o superior) #If Win32 Then Private Declare Function GetWindow Lib "user32" _ (ByVal hWnd As Long, ByVal wCmd As Long) As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _ (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _ (ByVal hWnd As Long) As Long Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long #Else Private Declare Function GetWindow Lib "User" _ (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer Private Declare Function GetWindowText Lib "User" _ (ByVal hWnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer Private Declare Function GetWindowTextLength Lib "User" _ (ByVal hWnd As Integer) As Integer Private Declare Function IsWindowVisible Lib "User" (ByVal hWnd As Integer) As Integer #End If 'Constantes para GetWindow Const GW_HWNDFIRST = 0 Const GW_HWNDLAST = 1 Const GW_HWNDNEXT = 2 Const GW_HWNDPREV = 3 Const GW_OWNER = 4 Const GW_CHILD = 5 'Esta es la "madre" del cordero Public Sub EjecutarPrograma(queForm As Form, quePrograma As String, queVentana As String) '---------------------------------------------------- 'Ejecuta el programa y espera a que termine 'Parámetros: ' queForm Nombre del formulario desde el que se hará la llamada ' quePrograma Programa a ejecutar con los parámetros necesarios ' queVentana Nombre a comprobar en el caption de las ventanas abiertas '---------------------------------------------------- #If Win32 Then Dim x As Long #Else Dim x As Integer #End If On Local Error Resume Next x = Shell(quePrograma, 1) If Err Then MsgBox "Se ha producido el siguiente error:" & vbCrLf & _ "Err=" & Str$(Err) & " " & Error$ Err = 0 Exit Sub End If ' 'Dar tiempo a que se active... ' Dim t As Long Dim nSeg As Integer t = Timer nSeg = 1 'Con un segundo suele ser suficiente 'Esperar nSeg segundos Do While t + nSeg > Timer DoEvents Loop 'Repetir el bucle mientras esté funcionando... Do While LeerTareas(queForm, queVentana) DoEvents Loop End Sub 'Aunque esta también ayuda Private Function LeerTareas(elForm As Form, sTarea As String) As Integer '-------------------------------------------------- 'Leer las tareas activas y comprobar si la especificada 'está funcionando... 'Parámetros: ' elForm Form actual ' sTarea Tarea a comprobar '-------------------------------------------------- #If Win32 Then Dim CurrWnd As Long Dim Length As Long Dim hwndDlg As Long #Else Dim CurrWnd As Integer Dim Length As Integer Dim hwndDlg As Integer #End If ' Dim ListItem As String Dim sTmp As String Dim Activada As Integer ' ' Activada = False 'Con GW_HWNDFIRST, lee todas las ventanas hwndDlg = elForm.hWnd CurrWnd = GetWindow(hwndDlg, GW_HWNDFIRST) If CurrWnd Then Do While CurrWnd <> 0 DoEvents If CurrWnd <> hwndDlg And IsWindowVisible(CurrWnd) _ And (hwndDlg <> GetWindow(CurrWnd, GW_OWNER)) Then Length = GetWindowTextLength(CurrWnd) ListItem = Space$(Length) Length = GetWindowText(CurrWnd, ListItem, Length + 1) If Length > 0 Then 'Comprobar si es la que queremos sTmp = Trim$(ListItem) If InStr(sTmp, sTarea) Then If InStr(sTmp, "Finaliza") Then 'cerrar esa ventana AppActivate sTmp SendKeys "%{F4}", True Activada = False Else Activada = True End If Exit Do End If End If End If CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT) Loop End If LeerTareas = Activada End FunctionBueno, ese era el código del módulo Shell_32.bas.
Ahora veamos el Form de Prueba.'-------------------------------------------------- ' Prueba para uso de Shell en Windows95/NT ' ' Autor: Guillermo Som ' Fecha: 21/Dic/96 '-------------------------------------------------- Option Explicit Option Compare Text 'Variables para los programas a cargar: Dim sPrograma() As String 'Programas Dim sIcono() As String 'Fichero de icono, dejarlo en blanco para usar el icono del programa Dim sVentana() As String 'Caption a comprobar en las ventanas abiertas ' 'Declaraciones del API de 16 y 32 bits (sólo para VB4 o superior) #If Win32 Then Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long Private Declare Function GetClassWord Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long #Else Private Declare Function ExtractIcon Lib "Shell" (ByVal hInstance As Integer, ByVal pszExeName As String, ByVal hIcon As Integer) As Integer Private Declare Function GetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer Private Declare Function DrawIcon Lib "User" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal hIcon As Integer) As Integer #End If ' Const GCW_HMODULE = (-16) Private Sub Command1_Click(Index As Integer) 'Ejecutar el programa indicado en sPrograma(Index) ' Dim i As Integer LblEstado = "Ejecuntando " & sVentana(Index) 'Desactivar los botones For i = 0 To 1 Command1(i).Enabled = False Next DoEvents EjecutarPrograma Me, sPrograma(Index), sVentana(Index) 're-activar los botones For i = 0 To 1 Command1(i).Enabled = True Next LblEstado = "" DoEvents End Sub Private Sub CmdSalir_Click() Unload Me End End Sub Private Sub Form_Load() Dim sTmp As String LblEstado = "" sTmp = "Para comprobar el programa," & vbCrLf sTmp = sTmp & "pulsa en cualquiera de los botones." & vbCrLf sTmp = sTmp & "El primero carga Notepad," & vbCrLf sTmp = sTmp & "el segundo llama a pkzip ? " & vbCrLf sTmp = sTmp & "(si no tienes pkzip, usa otro programa que trabaje en MS-DOS)," & vbCrLf sTmp = sTmp & "cuando el programa termine, se indicará en la parte inferior." Label2 = sTmp sTmp = "" Show '--- 'Especificar aquí los programas a cargar... ' ReDim sPrograma(1) ReDim sIcono(1) ReDim sVentana(1) ' 'Incluir en sPrograma los parámetros... ' 'El contenido de sVentana() será parte del caption 'que la ventana vaya a tener... ' 'Ejemplo, Notepad siempre indica ' "Nombre_archivo - Bloc de notas" ' 'Primer programa: sPrograma(0) = "c:\windows\notepad.exe" sIcono(0) = "" sVentana(0) = "Bloc" ' 'Segundo programa: sPrograma(1) = "pkzip.exe -?" 'Este icono se incluye en el archivo comprimido sIcono(1) = "pkzip.ico" sVentana(1) = "Pkzip" ' Dim i As Integer For i = 0 To 1 MostrarIcono sPrograma(i), sIcono(i), Picture1(i) Next ' End Sub Private Sub Form_Unload(Cancel As Integer) Set FrmShell = Nothing End Sub Private Sub MostrarIcono(quePrograma As String, queIcono As String, queControl As Control) 'Cargar el icono del programa '---------------------------------------------- 'Los parámetros son: ' quePrograma El path al programa ' queIcono El path al icono o vacío si se usa el icono del programa ' queControl El control en el que se pintará el icono, normalmente será un Picture '---------------------------------------------- #If Win32 Then Dim elhInst As Long Dim hIcon As Long Dim i As Long #Else Dim elhInst As Integer Dim hIcon As Integer Dim i As Integer #End If elhInst = GetClassWord(hWnd, GCW_HMODULE) If Len(queIcono) = 0 Then queIcono = quePrograma 'Si se quiere especificar un número determinado de icono dentro de un programa 'cambiar el 0 por una variable que apunte al icono deseado '(empieza por 0) hIcon = ExtractIcon(elhInst, queIcono, 0) If hIcon Then queControl.Picture = LoadPicture("") queControl.AutoRedraw = -1 i = DrawIcon(queControl.hdc, 0, 0, hIcon) queControl.Refresh End If Else queControl.Picture = LoadPicture(queIcono) End If End SubY ahora una "foto" del form de prueba.
2.- Cómo saber si un programa ha finalizado (VB3) (3/Mar)
Ahora viene el ejemplo de VB3.
En este he incluido un método para "convertir" una orden del DOS en un archivo BAT.
Después lo pondré explicado un poco más abajo.Ahora veamos el contenido de Shell_16.bas:
'--------------------------------------------------------------- 'Shell_16.bas ( 2/Mar/97) ' 'Módulo para comprobar si una tarea MS-DOS ha finalizado 'y cerrar la ventana asociada. 'Sirve para VB3 o anterior, 'si usas VB4 o superior, usa el módulo Shell_32.bas ' 'Este código es de libre uso/distribución, facilitado por: 'Guillermo Som Cerezo 'Web: http://guille.costasol.net 'Correo: <mensaje@elguille.info> o <mensaje@elguille.info> '--------------------------------------------------------------- Option Explicit Option Compare Text Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%) Declare Function FindWindow% Lib "User" (ByVal lpClassName As Any, ByVal lpCaption As Any) Sub EjecutarPrograma (quePrograma As String, queVentana As String) Dim x As Integer On Error Resume Next 'Ejecutar minimizado y sin foco x = Shell(quePrograma, 6) If Err Then Exit Sub End If 'Comprobar si aún está activa 'ATENCIÓN, NO QUITAR EL DOEVENTS, 'O SE QUEDARÁ COLGADO Do While GetModuleUsage(x) > 0 DoEvents If FindWindow(0&, "Finalizado - " + queVentana) Then AppActivate "Finalizado - " + queVentana SendKeys "%{F4}", True Exit Do End If Wend Loop While x End Sub
Ahora el módulo de prueba:
'---------------------------------------------------------- 'Shell_16.Frm ( 2/Mar/97) ' 'Prueba para ejecutar un programa y esperar a que termine 'también nos dice la etiqueta del volumen... ' '---------------------------------------------------------- Option Explicit Sub cmdAccion_Click () 'Comprobar la etiqueta del volumen y mostrarla Dim i As Integer Dim sUd As String Dim sProg As String Dim sFic As String Dim sTmp As String Dim Hallado As Integer Dim sVolumen As String Dim sNumSerie As String Label1(3).Caption = "Procesando la información..." DoEvents sUd = Trim$(Text1.Text) i = InStr(sUd, ":") If i = 0 Then MsgBox "Debes especificar una unidad de disco." Unload Me End End If sUd = Left$(sUd, i) sFic = sUd & "\Files.txt" 'Fichero para ejecutar el comando DIR sProg = sUd & "\~Files.bat" sUd = sUd & "\*.*" i = FreeFile Open sProg For Output As i Print #i, "Dir " & sUd & " >" & sFic Close i EjecutarPrograma sProg, "~Files" 'Ya ha finalizado... 'Abrir el archivo sFic ' If Len(Dir$(sFic)) Then 'Abrirlo i = FreeFile Open sFic For Input As i Do While Not EOF(i) Line Input #i, sTmp If InStr(sTmp, "volume") Then Hallado = True sVolumen = sTmp If Not EOF(i) Then Line Input #i, sNumSerie End If Exit Do End If Loop Close i If Hallado Then 'Obtener la etiqueta y el número de serie UltimaPalabra sVolumen UltimaPalabra sNumSerie If Len(sVolumen) = 0 Then sVolumen = "No tiene etiqueta de volumen?" End If If (Len(sNumSerie) = 0 Or InStr(sNumSerie, "-") = 0) Then sNumSerie = "No tiene número de serie?" End If Label1(3).Caption = sVolumen & " - " & sNumSerie Label2(0).Caption = sVolumen Label2(1).Caption = sNumSerie Else Label1(3).Caption = "No se encuentra la etiqueta del volumen..." End If Else MsgBox "No se ha podido crear el fichero: " & sFic End If 'Borrar los archivos If Len(Dir$(sProg)) Then Kill sProg End If If Len(Dir$(sFic)) Then Kill sFic End If Text1.SetFocus End Sub Sub cmdSalir_Click () Unload Me End End Sub Sub Form_Unload (Cancel As Integer) Set Form1 = Nothing End Sub Sub UltimaPalabra (sFrase As String) 'De la cadena sFrase obtiene la última palabra 'Realmente lo que haya desde el último espacio Dim i As Integer Dim sPalabra As String 'Buscar el último espacio sPalabra = "" 'Asegurarnos de no encontrar espacios al final de la cadena sFrase = Trim$(sFrase) For i = Len(sFrase) To 1 Step -1 If Mid$(sFrase, i, 1) = " " Then sPalabra = Mid$(sFrase, i + 1) Exit For End If Next sFrase = Trim$(sPalabra) End SubY para terminar, como es costumbre, una foto del formulario
3.- Obtener la etiqueta y número de serie del volumen en VB de 16 bits. (3/Mar)
Esto está sacado del ejemplo anterior, así que míralo y verás como hacerlo.
Lo pongo como truco separado, para que "lo encuentres" cuando lo busques. De nada. 8-)
4.- Usar Shell para ejecutar una orden del MS-DOS (3/Mar)
Esto está sacado del truco número 2, así que míralo y verás como hacerlo.
También lo pongo como truco separado, para que "lo encuentres" cuando lo busques. De nada otra vez. 8-)