Auto_Run

 

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  Retardo

Donde:
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:

  1. Lee la línea de comandos y asigna los valores para los tres datos que necesita
  2. Hacemos un bucle que comprueba si tiene que ejecutar el programa

    Las rutinas y funciones:
  3. Las declaraciones
  4. Form_Load
  5. Form_Unload
  6. Main
  7. EjecutarPrograma
  8. TareaFinalizada
  9. Comentario sobre los nuevos cambios
  10. La nueva versión de Main
  11. La rutina de espera WaitSeconds
  12. Las nuevas declaraciones
  13. La rutina de espera especial para el programa EsperarQueTermine
  14. 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)

4.- Las rutinas: Form_Load

 
'
Private Sub Form_Load()
    Main
End Sub

5.- Las rutinas: Form_Unload

 
'
Private Sub Form_Unload(Cancel As Integer)
    Set Form1 = Nothing
End Sub

6.- Las rutinas: 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#
    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

 

ir al índice