[RESOLVED] Self Restart an Application

[WeeBee]

Self Restart an Application:
How to restart a VB6 created application automatically if crashed...?

[LaVolpe]

Fix the reason for the crash. Error trapping. Otherwise you can build a separate app that monitors your main app and if it closes without informing that monitoring app, your monitoring app can restart it. Your question is more in line with putting on a band-aid. Determining why it crashed is what I believe to be the right solution.

[LeandroA]

Hi this module Restart the application if the error is standar

in module public

Option Explicit
'Autor: Leandro Ascierto
'Web:   www.leandroascierto.com.ar
'Date:  28/12/2009
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub FatalExit Lib "kernel32" (ByVal code As Long)

Dim hWinStatic As Long
Dim AppPath As String
Dim LastError As Long

Private Function CallSomeFunction()
    'No borrar esta linea
End Function

Public Sub StarProtect()
    hWinStatic = CreateWindowEx(0, "Static", "WindowControlerCrash", 0, 0, 0, 0, 0, 0, 0, 0, 0&)
    AppPath = GetAppPath
    SetTimer hWinStatic, 0, 100, AddressOf TimerProc
End Sub

Public Sub EndProtect()
    KillTimer hWinStatic, 0
    DestroyWindow hWinStatic
End Sub

Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
    Dim Ret As String
    
    If Err.Number = 40040 Then
        ShellExecute hWinStatic, vbNullString, AppPath, LastError, vbNullString, 1
        FatalExit 1
    Else
        LastError = Err.Number
        Ret = CallSomeFunction
    End If
    
End Sub

Private Function GetAppPath() As String
    Dim ModuleName As String
    Dim Ret As Long
    ModuleName = String$(255, Chr$(0))
    Ret = GetModuleFileName(App.hInstance, ModuleName, 255)
    GetAppPath = Left$(ModuleName, Ret)
End Function

Test: put three Command Button in a Form and compile the project

Option Explicit

Private Sub Form_Load()
    If Command$ <> "" Then Me.Caption = "Aplicaci&#243;n Reinciada por error: " & Command$
    StarProtect 'comienza la protecci&#243;n
End Sub

Private Sub Form_Unload(Cancel As Integer)
    EndProtect 'Detiene la protecci&#243;n
End Sub


Private Sub Command1_Click()
    MsgBox 1 / 0 'Error Divici&#243;n por cero
End Sub

Private Sub Command2_Click()
    Dim i As Integer
    i = 8000000000000# 'Error Desvordamiento
End Sub

Private Sub Command3_Click()
    Dim c As Date
    c = "hola" 'Error no coinciden los tipos
End Sub

Original Post

[WeeBee]

LaVolpe, you are absolutely right...i have to trap the errors effectively...Thank you very much

LeandroA ---Your code is working! thanks a lot man