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: <[email protected]> o <[email protected]> '--------------------------------------------------------------- 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-)