Revisión del 10/Feb/97
Baja el archivo con los listados y el ejecutable: auto_run.zip 8.45 KB (de la revisión 1.0.1)
Esta utilidad ejecuta cada X minutos el programa indicado en la línea de comandos.
Para usarlo:
auto_run Programa Tiempo_de_espera RetardoDonde:
Programa es el programa, con el path y las opciones, se recomienda que esté entre comillas
Tiempo_de_espera son los minutos de diferencia entre cada una de las ejecuciones
Retardo el tiempo, en segundos, que dejará el programa de lapso después de ejecutar el programa.
Prueba con distintos valores si ves que "tarda" en cerrar la ventana una vez finalizada.
Veamos lo que hace, paso a paso:
- Lee la línea de comandos y asigna los valores para los tres datos que necesita
- Hacemos un bucle que comprueba si tiene que ejecutar el programa
Las rutinas y funciones:- Las declaraciones
- Form_Load
- Form_Unload
- Main
- EjecutarPrograma
- TareaFinalizada
- Comentario sobre los nuevos cambios
- La nueva versión de Main
- La rutina de espera WaitSeconds
- Las nuevas declaraciones
- La rutina de espera especial para el programa EsperarQueTermine
- La nueva versión de TareaFinalizada
1.- Lee la línea de comandos y asigna los valores para los tres datos que necesita
'El primer parámetro debe ser el programa 'comprobar si se incluyen comillas j = InStr(sCmd, Chr$(34)) If j Then i = InStr(j + 1, sCmd, Chr$(34)) sTmp = Mid$(sCmd, j + 1, i - (j + 1)) sCmd = Mid$(sCmd, i + 1) Else j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If End If sProg = sTmp 'Si no se indica el programa, terminar If Len(sProg) = 0 Then End End If sCmd = Trim$(sCmd) 'Segundo parámetro: el tiempo de retardo j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If ' t# = Val(sTmp) If t# < 0 Then 'Si no se ha asignado el tiempo, ponerlo para 30 minutos t# = 30# End If 'Convertirlo en segundos Tiempo = t# * 60 '------------------------------------------------------ 'El tiempo debe estar especificado en minutos 'no en minutos.segundos ' 5.20 NO serán 5 minutos y 20 segundos sino ' 5.2 * 60 = 312 segundos, es decir 5 min y 12 seg '------------------------------------------------------- ' sCmd = Trim$(sCmd) 'El tercer parámetro será el Respiro para la CPU j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If Respiro = Val(sTmp) If Respiro < 1 Then 'si no se indica el tiempo de Respiro, darle 5 segundos Respiro = 5 End If
2.- Hacemos un bucle que comprueba si tiene que ejecutar el programa
'Empieza el espectáculo Ejecutandose = False 'Para que se ejecute al entrar en el programa t# = Timer - Tiempo '////////////////////////////////////////////// '// ¡ Este bucle se repite indefinidamente ! // '////////////////////////////////////////////// Do DoEvents 'Usar la función del API, es más exacta que Timer If Timer - t# >= Tiempo Then 'Ejecutar la aplicación t# = Timer 'Actualizar el contador EjecutarPrograma sProg 'Flag para saber si hay que comprobar si ha finalizado Ejecutandose = True End If If Ejecutandose Then ' 'Comprobar si ya ha finalizado DoEvents If TareaFinalizada() = False Then 'Usar este bucle para dar un Respiro entre cada chequeo, 'con idea de que TareaFinalizada no consuma 'todo el tiempo del procesador!!! x = Timer 'Esperar los segundos indicados en Respiro Do DoEvents Loop While x + Respiro > Timer Else Ejecutandose = False End If End If Loop
3.- Las rutinas: Las declaraciones
'Declaraciones del Form ' Option Explicit Option Compare Text ' 'Funciones del API de 32 bits ' 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 'Constantes para GetWindow Const GW_CHILD = 5 Const GW_HWNDFIRST = 0 Const GW_HWNDLAST = 1 Const GW_HWNDNEXT = 2 Const GW_HWNDPREV = 3 Const GW_OWNER = 4 ' Const GCW_HMODULE = (-16)
' Private Sub Form_Load() Main End Sub
' Private Sub Form_Unload(Cancel As Integer) Set Form1 = Nothing End Sub
' Private Sub Main() 'Procedimiento de entrada Dim sCmd As String Dim i As Integer Dim j As Integer Dim sTmp As String Dim t# Dim x As Long Dim sProg As String 'Programa a ejecutar Dim Tiempo As Long 'Segundos de espera Dim Respiro As Integer 'Tiempo de "descanso" para el procesador Dim Ejecutandose As Boolean 'Flag, para saber si debemos comprobar si ha finalizado o no sCmd = Trim$(Command$) 'Leer la línea de comandos 'Terminar si no se asigna la línea de comandos If Len(sCmd) = 0 Then End End If 'Minimizar la ventana, aunque no haya ventana!!! WindowState = vbMinimized 'por si las moscas, la ocultamos Hide 'windows tiene algo que decir? DoEvents 'El primer parámetro debe ser el programa 'comprobar si se incluyen comillas j = InStr(sCmd, Chr$(34)) If j Then i = InStr(j + 1, sCmd, Chr$(34)) sTmp = Mid$(sCmd, j + 1, i - (j + 1)) sCmd = Mid$(sCmd, i + 1) Else j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If End If sProg = sTmp 'Si no se indica el programa, terminar If Len(sProg) = 0 Then End End If sCmd = Trim$(sCmd) 'Segundo parámetro: el tiempo de retardo j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If ' t# = Val(sTmp) If t# < 0 Then 'Si no se ha asignado el tiempo, ponerlo para 30 minutos t# = 30# End If 'Convertirlo en segundos Tiempo = t# * 60 '------------------------------------------------------ 'El tiempo debe estar especificado en minutos 'no en minutos.segundos ' 5.20 NO serán 5 minutos y 20 segundos sino ' 5.2 * 60 = 312 segundos, es decir 5 min y 12 seg '------------------------------------------------------- ' sCmd = Trim$(sCmd) 'El tercer parámetro será el Respiro para la CPU j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If Respiro = Val(sTmp) If Respiro < 1 Then 'si no se indica el tiempo de Respiro, darle 5 segundos Respiro = 5 End If 'Empieza el espectáculo Ejecutandose = False 'Para que se ejecute al entrar en el programa t# = Timer - Tiempo '////////////////////////////////////////////// '// ¡ Este bucle se repite indefinidamente ! // '////////////////////////////////////////////// Do DoEvents 'Usar la función del API, es más exacta que Timer If Timer - t# >= Tiempo Then 'Ejecutar la aplicación t# = Timer 'Actualizar el contador EjecutarPrograma sProg 'Flag para saber si hay que comprobar si ha finalizado Ejecutandose = True End If If Ejecutandose Then ' 'Comprobar si ya ha finalizado DoEvents If TareaFinalizada() = False Then 'Usar este bucle para dar un Respiro entre cada chequeo, 'con idea de que TareaFinalizada no consuma 'todo el tiempo del procesador!!! x = Timer 'Esperar los segundos indicados en Respiro Do DoEvents Loop While x + Respiro > Timer Else Ejecutandose = False End If End If Loop End Sub
7.- Las rutinas: EjecutarPrograma
' Private Sub EjecutarPrograma(quePrograma As String) '---------------------------------------------------- 'Ejecuta el programa y espera a que termine 'Parámetros: ' quePrograma Programa a ejecutar con los parámetros necesarios '---------------------------------------------------- Dim x As Long Const nSeg = 1 'Con un segundo suele ser suficiente On Local Error Resume Next x = Shell(quePrograma, vbMinimizedNoFocus) If Err Then MsgBox "Se ha producido el siguiente error:" & vbCrLf & "Err=" & Str$(Err) & " " & Error$ Err = 0 Unload Me End 'Exit Sub End If ' 'Dar tiempo a que se active... ' x = Timer 'Esperar nSeg segundos para que de tiempo a activarse Do While x + nSeg > Timer DoEvents Loop End Sub
8.- Las rutinas: TareaFinalizada
' Private Function TareaFinalizada() As Boolean '-------------------------------------------------- 'Comprobar si hay alguna tarea que haya finalizado '¡¡¡ esto sólo funciona con los programas de MS-DOS !!! '-------------------------------------------------- ' 'Las variables estáticas aceleran la ejecución 'al no tener que crearse cada vez que se entra en la función ' Static CurrWnd As Long Static Length As Long Static hwndDlg As Long ' Static ListItem As String Static sTmp As String Static Finalizada As Boolean 'Flag para saber si está finalizada ' ' Finalizada = False 'Con GW_HWNDFIRST, lee todas las ventanas hwndDlg = Form1.hWnd CurrWnd = GetWindow(hwndDlg, GW_HWNDFIRST) If CurrWnd Then 'Chequear todas las ventanas 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 hay alguna tarea finalizada sTmp = Trim$(ListItem) If InStr(sTmp, "Finaliza") Then 'cerrar esa ventana AppActivate sTmp SendKeys "%{F4}", True Finalizada = True Exit Do End If End If End If CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT) Loop End If 'TareaFinalizada devuelve True si hay una tarea finalizada TareaFinalizada = Finalizada End Function
9.- Comentario sobre los nuevos cambios
El cambio principal es usar una rutina de pausa WaitSeconds, proporcionada por Joe LeVasseur.
Esta rutina soluciona el problema de que cambie el día cuando se está dentro del bucle.
Como sabrás la función Timer devuelve el número de segundos transcurridos desde la medianoche.
Además se han hecho una serie de modificaciones a las rutinas, para que se adapten a esta nueva rutina.
La función TareaFinalizada se ha convertido en un sub (procedimiento), ya que no necesita devolver el estado de que se haya finalizado o no; esto se comprueba cada cierto tiempo, el especificado en Retardo, para que no nos produzca situaciones "extrañas".
Lo único que hay que arreglar es que la aplicación que se esté activa cuando se "lanza" el programa que queremos ejecutar cada cierto tiempo, siga teniendo el foco.
He probado GetActiveWindow y SetActiveWindow, pero sólo trabaja con las aplicaciones dentro del mismo "Thread"
A ver si alguien me ayuda en este punto. Gracias.
Ahora el programa mostrará el nombre: Auto_Run (Ejecutandose) en lugar de (Manolito)
10.- Las rutinas: la nueva versión de Main
' Private Sub Main() 'Procedimiento de entrada Dim sCmd As String Dim i As Integer Dim j As Integer Dim sTmp As String Dim t As Double Dim sProg As String 'Programa a ejecutar Dim Tiempo As Long 'Segundos de espera sCmd = Trim$(Command$) 'Leer la línea de comandos 'Terminar si no se asigna la línea de comandos If Len(sCmd) = 0 Then End End If 'Minimizar la ventana, aunque no haya ventana!!! WindowState = vbMinimized 'por si las moscas, la ocultamos Hide 'windows tiene algo que decir? DoEvents 'El primer parámetro debe ser el programa 'comprobar si se incluyen comillas j = InStr(sCmd, Chr$(34)) If j Then i = InStr(j + 1, sCmd, Chr$(34)) sTmp = Mid$(sCmd, j + 1, i - (j + 1)) sCmd = Mid$(sCmd, i + 1) Else j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If End If sProg = sTmp 'Si no se indica el programa, terminar If Len(sProg) = 0 Then End End If sCmd = Trim$(sCmd) 'Segundo parámetro: el tiempo de retardo j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If ' t = Val(sTmp) If t < 0 Then 'Si no se ha asignado el tiempo, ponerlo para 30 minutos t = 30# End If 'Convertirlo en segundos Tiempo = t * 60 '------------------------------------------------------ 'El tiempo debe estar especificado en minutos 'no en minutos.segundos ' 5.20 NO serán 5 minutos y 20 segundos sino ' 5.2 * 60 = 312 segundos, es decir 5 min y 12 seg '------------------------------------------------------- sCmd = Trim$(sCmd) 'El tercer parámetro será el Respiro para la CPU j = InStr(sCmd, Chr$(32)) If j Then sTmp = Left$(sCmd, j - 1) sCmd = Mid$(sCmd, j + 1) Else sTmp = sCmd sCmd = "" End If Respiro = Val(sTmp) If Respiro < 1 Then 'si no se indica el tiempo de Respiro, darle 5 segundos Respiro = 5 End If 'Empieza el espectáculo Ejecutandose = False '////////////////////////////////////////////// '// ¡ Este bucle se repite indefinidamente ! // '////////////////////////////////////////////// Do 'Ejecutar la aplicación EjecutarPrograma sProg 'Hacer la pausa indicada... EsperarQueTermine Tiempo Loop End Sub
11.- Las rutinas: la rutina de espera WaitSeconds
' Private Sub WaitSeconds(N As Long) 'Este sub es como delay en Pascal 'Rutina proporcionada por Joe LeVasseur 'Home page: http://www.tiac.net/users/lvasseur ' Dim NowTimer As Double Dim BeginTimer As Double Dim TimeDiff As Long BeginTimer = Timer Do DoEvents NowTimer = Timer If NowTimer < BeginTimer Then TimeDiff = 86400 + NowTimer - BeginTimer Else TimeDiff = NowTimer - BeginTimer End If Loop Until TimeDiff >= N End Sub
12.- Las rutinas: Añadir estas declaraciones
Dim Ejecutandose As Boolean 'Flag, para saber si debemos comprobar si ha finalizado o no Dim Respiro As Long 'Pausa para los chequeos por si ha finalizado el proceso MS-DOS
13.- Las rutinas: la rutina de espera especial para el programa EsperarQueTermine
' Private Sub EsperarQueTermine(N As Long) 'Basada en la rutina WaitSeconds Dim NowTimer As Double Dim BeginTimer As Double Dim TimeDiff As Long BeginTimer = Timer Do DoEvents NowTimer = Timer If NowTimer < BeginTimer Then TimeDiff = 86400 + NowTimer - BeginTimer Else TimeDiff = NowTimer - BeginTimer End If WaitSeconds Respiro 'Comprobar si la tarea ha finalizado TareaFinalizada Loop Until TimeDiff >= N End Sub
14.- Las rutinas: Nueva versión de TareaFinalizada
' Private Sub TareaFinalizada() '-------------------------------------------------- 'Comprobar si hay alguna tarea que haya finalizado '¡¡¡ esto sólo funciona con los programas de MS-DOS !!! '-------------------------------------------------- ' 'Las variables estáticas aceleran la ejecución 'al no tener que crearse cada vez que se entra en la función ' Static CurrWnd As Long Static Length As Long Static hwndDlg As Long ' Static ListItem As String Static sTmp As String 'Con GW_HWNDFIRST, lee todas las ventanas hwndDlg = Form1.hWnd CurrWnd = GetWindow(hwndDlg, GW_HWNDFIRST) If CurrWnd Then 'Chequear todas las ventanas 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 hay alguna tarea finalizada sTmp = Trim$(ListItem) If InStr(sTmp, "Finaliza") Then 'cerrar esa ventana AppActivate sTmp SendKeys "%{F4}", True Exit Do 'Esperar un segundo WaitSeconds 1 End If End If End If CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT) Loop End If End Sub