Visual Basic Foro

Programación => Visual Basic 6 => Mensaje iniciado por: pepino en Agosto 12, 2014, 02:39:31 pm

Título: Reinicio de proceso al cerrar
Publicado por: pepino en Agosto 12, 2014, 02:39:31 pm

Modulo:

Código: (VB) [Seleccionar]

Public Sub Reinicio_Aplicacion_01(ByVal strP_Proceso_01 As String, ByVal strP_Aplicacion_01 As String, _
Optional ByVal bolP_Control_ID_01 As Boolean = False, _
Optional ByVal lonP_ID_Proceso_01 As Long)
'
'---------------------------------------------'
' FUNCION PARA EL REINICIO DE UNA APLICACION  '
'                                             '
' UTILIZA UN VBSCRIPT QUE SE CREA, SE EJECUTA '
' Y ESPERA A LA FINALIZACION DE LA APLICACION '
' PARA VOLVERLE A EJECUTAR                    '
'---------------------------------------------'
'
Dim strL_Fichero_01 As String
'
Dim objL_Script_01 As Object
Dim objL_Create_Script_01 As Object
'
strL_Fichero_01 = App.Path & "\restart_api_" & Format(Now(), "YYYYMMDDHhNnSs") & ".vbs"
'
If (Dir(strL_Fichero_01) = "Proyecto1") Then Kill (strL_Fichero_01)
'
Set objL_Script_01 = CreateObject("Scripting.FileSystemObject")
'
Set objL_Create_Script_01 = objL_Script_01.CreateTextFile(strL_Fichero_01, False)
'
With objL_Create_Script_01
.WriteLine "Option Explicit"
.WriteLine "'-------------------------------------'"
.WriteLine "' VBSCRIPT QUE REINICIA LA APLICACION '"
.WriteLine "' '" & strP_Aplicacion_01 & "'        '"
.WriteLine "' CUANDO ESTA SE CIERRA               '"
.WriteLine "'-------------------------------------'"
.WriteLine "'"
.WriteLine "Const strComputer = ""."" "
.WriteLine "'"
.WriteLine "Dim objWMIService"
.WriteLine "Dim colProcessList"
.WriteLine "Dim bolL_Proceso_Terminado"
.WriteLine "Dim objProcess"
.WriteLine "Dim WshShell"
.WriteLine "Dim oExec"
.WriteLine "'"
.WriteLine "Set objWMIService = GetObject(""winmgmts:"" & ""{impersonationLevel=impersonate}!\\"" & strComputer & ""\root\cimv2"")"
.WriteLine "'"
.WriteLine "Do"
.WriteLine "    Set colProcessList = objWMIService.ExecQuery(""SELECT * FROM Win32_Process WHERE Name = '" & strP_Proceso_01 & "'"")"
.WriteLine "    bolL_Proceso_Terminado = true"
.WriteLine "    '"
.WriteLine "    For Each objProcess in colProcessList"
If (bolP_Control_ID_01 = False) Then
.WriteLine "        WScript.Echo ""¡ENCONTRADO EL PROCESO '" & strP_Proceso_01 & "' !"""
.WriteLine "        bolL_Proceso_Terminado = False"
''
Else
.WriteLine "        If (objProcess.ProcessId = " & lonP_ID_Proceso_01 & ") Then"
.WriteLine "            WScript.Echo ""¡ENCONTRADO EL PROCESO '" & strP_Proceso_01 & "' ID:" & lonP_ID_Proceso_01 & " !"""
.WriteLine "            bolL_Proceso_Terminado = False"
.WriteLine "            ''"
.WriteLine "        End If"
''
End If
.WriteLine "        '"
.WriteLine "        WScript.Sleep 1000 ' NO SATUREMOS EL SISTEMA"
.WriteLine "        ''"
.WriteLine "    Next"
.WriteLine "    ''"
.WriteLine "Loop While bolL_Proceso_Terminado = False"
.WriteLine "'"
.WriteLine "' EL PROCESO O TERMINO O NO EXISISTIA"
.WriteLine "' ENTONCES LO VOLVEMOS A EJECUTAR"
.WriteLine "'"
.WriteLine "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
.WriteLine "Set oExec = WshShell.Exec(""" & strP_Aplicacion_01 & """)"
.WriteLine "WScript.Echo ""¡ARRANQUE DE LA APLICACION '" & strP_Aplicacion_01 & "' FINALIZADO!"""
'
.Close
''
End With
'
Set objL_Create_Script_01 = Nothing
Set objL_Script_01 = Nothing
'
Call Log("MENSAJE_Reinicio_Aplicacion_01_01 - REINICIO APLICACION: '" & strP_Aplicacion_01 & "' ID:" & lonP_ID_Proceso_01)
'
Shell "cscript """ & strL_Fichero_01 & """"
''
End Sub

Formulario:

Código: (VB) [Seleccionar]

Private Sub Form_Load()
'
On Error GoTo 0
'
Exit Sub
'
Manejar_Errores_Apertura_01:
'MsgBox "Error al intentar abrir COM" & Connect_RS232.CommPort, vbCritical, "mdlRS232 [Evento_01_Timer_RS232]"
'MsgBox "Error detectado por Visual Basic: " & vbCrLf & Err.Description, vbCritical, "mdlRS232 [Evento_01_Timer_RS232]"
'
Call Log("ERROR_Timer_RS232_Timer_01 - Error al intentar abrir COM" & Connect_RS232.CommPort)
Call Log("ERROR_Timer_RS232_Timer_01 - Error detectado por Visual Basic: " & vbCrLf & Err.Description)
'
Resume Salir
''
Manejar_Errores_Transmision_01:
'MsgBox "Ocurrió un error al intentar transmitir"
'MsgBox "Error detectado por Visual Basic: " & vbCrLf & Err.Description, vbCritical, "mdlIberia_RS232 [Evento_01_Timer_RS232]"
'
Call Log("ERROR_Timer_RS232_Timer_02 - Ocurrió un error al intentar transmitir")
Call Log("ERROR_Timer_RS232_Timer_02 - Error detectado por Visual Basic: " & vbCrLf & Err.Description)
'
If (Connect_RS232.PortOpen = True) Then Connect_RS232.PortOpen = False
'
Resume Salir
''
Manejar_Errores_Clausura_01:
'MsgBox "Error al intentar cerrar COM" & Connect_RS232.CommPort, vbCritical, "mdlRS232 [Evento_01_Timer_RS232]"
'MsgBox "Error detectado por Visual Basic: " & vbCrLf & Err.Description, vbCritical, "mdlRS232 [Evento_01_Timer_RS232]"
'
Call Log("ERROR_Timer_RS232_Timer_03 - Error al intentar cerrar COM" & Connect_RS232.CommPort)
Call Log("ERROR_Timer_RS232_Timer_03 - Error detectado por Visual Basic: " & vbCrLf & Err.Description)
'
Resume Salir
''
Salir:
' AQUI PUEDO PONER ALGO QUE QUIERA QUE SE EJECUTE
' EN CUALQUIER SITUACIÓN
'Stop
On Error GoTo 0
'
Call Reinicio_Aplicacion_01(App.EXEName & ".exe", App.EXEName & ".exe " & Command, True, GetCurrentProcessId)
End
''
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Reinicio_Aplicacion_01(App.EXEName & ".exe", App.EXEName & ".exe " & Command, True, GetCurrentProcessId)
End Sub
me marca error en el modulo en la linea:

Código: (VB) [Seleccionar]

Call Log("MENSAJE_Reinicio_Aplicacion_01_01 - REINICIO APLICACION: '" & strP_Aplicacion_01 & "' ID:" & lonP_ID_Proceso_01)No coinciden los datos
alguien me ayuda.

Título: Re:Reinicio de proceso al cerrar
Publicado por: coco en Agosto 12, 2014, 03:40:53 pm

Perdoname, pero lo que estas haciendo es totalmente desprolijo y derrochas un monton de recursos al ejecutar un script.
Hace otra aplicacion, que reciba como parametro el nombre del ".exe" que queres "escuchar". Aca te dejo una funcion que "espera" que terime un EXE arbitrario y luego sigue ejecutando lo que esta abajo...

Pega el codigo en un formulario y en el Form_Load llama a "WaitForExe(Command$)" y luego "Shell Command$" y finalmente "End". Pone que el form no sea visible.
(Tenes que hacerlo en un form porque si lo haces en un modulo usando el Sub Main los antivirus te van a botonear el exe).

Código: (vb) [Seleccionar]

Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000
Private Const MAX_PATH As Integer = 260

Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

Private Const INFINITE = &HFFFF

Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type

Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long


Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

Private Function GetPIDFromName(ByVal sName As String, _
                                ByRef lPID As Long) As Boolean
    Dim lSnap           As Long
    Dim pProcess        As PROCESSENTRY32
    Dim lReturn         As Long
    Dim sExeName        As String
   
    lSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    With pProcess
        .dwSize = Len(pProcess)
   
        lReturn = Process32First(lSnap, pProcess)
        Do While lReturn
       
            sExeName = Left$(.szExeFile, IIf(InStr(1, .szExeFile, Chr$(0)) > 0, InStr(1, .szExeFile, Chr$(0)) - 1, 0))

            If StrComp(sExeName, sName, vbTextCompare) = 0 Then
                GetPIDFromName = True
                lPID = .th32ProcessID
                Call CloseHandle(lSnap)
                Exit Function
            End If
           
            lReturn = Process32Next(lSnap, pProcess)
        Loop
    End With
   
    Call CloseHandle(lSnap)
End Function

Private Function WaitForExe(ByVal sName As String) As Boolean

    Dim lPID            As Long
    Dim lProcHandle     As Long
   
    If Not GetPIDFromName("notepad.exe", lPID) Then
        Exit Function
    End If
   
    lProcHandle = OpenProcess(SYNCHRONIZE, 0, lPID)
   
    If lProcHandle = 0 Then
        Exit Function
    End If
   
    Call WaitForSingleObject(lProcHandle, INFINITE)
   
    Call CloseHandle(lProcHandle)
   
    WaitForExe = True
End Function