Título: [Source] Reniciar la aplicacion ante un Error
Publicado por: LeandroA en 28 Diciembre 2009, 04:35 am
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.
Título: Re: [Source] Reniciar la aplicacion ante un Error
Publicado por: BlackZeroX en 28 Diciembre 2009, 05:49 am
Lo he probado y funciona bien!¡.
Por hay solo de de obtener el handle de una ventana creada con api de igual forma se puede quitar y pasarle un handle 0, aun que aun asi esta bueno
Ducles Lunas!¡.
Título: Re: [Source] Reniciar la aplicacion ante un Error
Publicado por: ssccaann43 © en 28 Diciembre 2009, 16:05 pm
Excelente Leandro!
|