Este es un modulo bas para Reiniciar la aplicación si es que aparece un error y no fue controlado (No errores de sistemas esos que aparece el maldito boton"No Enviar") sino los comunes de vb
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
Para probarlo en un formulario con Tres botones
Option Explicit
Private Sub Form_Load()
If Command$ <> "" Then Me.Caption = "Aplicación Reinciada por error: " & Command$
StarProtect 'comienza la protección
End Sub
Private Sub Form_Unload(Cancel As Integer)
EndProtect 'Detiene la protección
End Sub
Private Sub Command1_Click()
MsgBox 1 / 0 'Error Divició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
Lo compilan y verán que al producir un error la aplicacion se reinicia.
Saludos.
