Disable the crash dialog in VB6 (Visual Basic 6) with SetErrorMode()
If you don't want your Visual Basic 6 application to display the standard crash dialog, you can disable it by setting the SEM_NOGPFAULTERRORBOX flag in the process error mode.
The simple-minded way is just to do
SetErrorMode(SEM_NOGPFAULTERRORBOX);
but this overwrites the previous error mode rather than augmenting it. In other words, you inadvertently turned off the other error modes!
Unfortunately, there is no GetErrorMode function, so you have to do a double-shuffle.
Dim rc as Long rc = SetErrorMode(SEM_NOGPFAULTERRORBOX); SetErrorMode(rc Or SEM_NOGPFAULTERRORBOX); It works perfectly with VB6 and is very useful if you have to call a buggy third-party component, or a user-provided plugin that you don't trust. You can set the error mode right before calling the buggy dll and setting it back immediatelly after.
Sample VB6 code that disables the crash dialog with SetErrorMode:
Private Sub Form_Load() Dim rc As Long rc = SetErrorMode(0) rc = SetErrorMode(rc Or SEM_NOGPFAULTERRORBOX) rc = SetUnhandledExceptionFilter(AddressOf UnhandledExceptionFilter) End Sub
SetUnhandledExceptionFilter usage with VB6
SetUnhandledExceptionFilter enables an application to supersede the top-level exception handler of each thread of a process.
SetUnhandledExceptionFilter() doesn't seem to work very well with Visual Basic 6 (VB6). For some reason, no function or method calls are executed from within the exception handler, wich renders it almost useless. In C/C++ you can at least call functions and methods of the standard library. Therefore, unless someone proves me wrong, I believe that setting an unhandled exception handler with SetUnhandledExceptionFilter is pretty much useless in VB6.
Sample code that assigns an exception handler with SetUnhandledExceptionFilter that tries to turn the exception into a regular VB6 error. It doesn't work as expect for the reasons metioned above.
Option Explicit Public Declare Function SetUnhandledExceptionFilter Lib "kernel32" (ByVal lpTopKLevelExceptionFilter As Long) As Long Private Declare Sub CopyExceptionRecord Lib "kernel32" Alias "RtlMoveMemory" (pDest As EXCEPTION_RECORD, ByVal LPEXCEPTION_RECORD As Long, ByVal lngBytes As Long) Private Const EXCEPTION_MAXIMUM_PARAMETERS = 15 Private Type EXCEPTION_RECORD ExceptionCode As Long ExceptionFlags As Long pExceptionRecord As Long ExceptionAddress As Long NumberParameters As Long ExceptionInformation(EXCEPTION_MAXIMUM_PARAMETERS) As Long End Type Private Type EXCEPTION_DEBUG_INFO pExceptionRecord As Long dwFirstChance As Long End Type Private Type CONTEXT FltF0 As Double FltF1 As Double FltF2 As Double FltF3 As Double FltF4 As Double FltF5 As Double FltF6 As Double FltF7 As Double FltF8 As Double FltF9 As Double FltF10 As Double FltF11 As Double FltF12 As Double FltF13 As Double FltF14 As Double FltF15 As Double FltF16 As Double FltF17 As Double FltF18 As Double FltF19 As Double FltF20 As Double FltF21 As Double FltF22 As Double FltF23 As Double FltF24 As Double FltF25 As Double FltF26 As Double FltF27 As Double FltF28 As Double FltF29 As Double FltF30 As Double FltF31 As Double IntV0 As Double IntT0 As Double IntT1 As Double IntT2 As Double IntT3 As Double IntT4 As Double IntT5 As Double IntT6 As Double IntT7 As Double IntS0 As Double IntS1 As Double IntS2 As Double IntS3 As Double IntS4 As Double IntS5 As Double IntFp As Double IntA0 As Double IntA1 As Double IntA2 As Double IntA3 As Double IntA4 As Double IntA5 As Double IntT8 As Double IntT9 As Double IntT10 As Double IntT11 As Double IntRa As Double IntT12 As Double IntAt As Double IntGp As Double IntSp As Double IntZero As Double Fpcr As Double SoftFpcr As Double Fir As Double Psr As Long ContextFlags As Long Fill(4) As Long End Type Private Type EXCEPTION_POINTERS pExceptionRecord As EXCEPTION_RECORD ContextRecord As CONTEXT End Type Private Const EXCEPTION_EXECUTE_HANDLER = 1 Private Const EXCEPTION_DEBUG_EVENT = 1 Private Const EXCEPTION_CONTINUE_SEARCH = 0 Private Const EXCEPTION_CONTINUE_EXECUTION = -1 Private Function GetExceptionText(ByVal ExceptionCode As Long) As String 'This function receives an exception code value and returns the 'text description of the exception Select Case ExceptionCode ' Case EXCEPTION_ACCESS_VIOLATION ' GetExceptionText = "Access violation" ' Case EXCEPTION_DATATYPE_MISALIGNMENT ' GetExceptionText = "Data type misalignment" '...... '...... Case Else GetExceptionText = "Unknown (&H" & Right("00000000" & Hex(ExceptionCode), 8) & ")" End Select End Function Public Function UnhandledExceptionFilter(ByRef ExceptionPtrs As EXCEPTION_POINTERS) As Long Dim Rec As EXCEPTION_RECORD, ExceptionText As String 'Get the current exception record. Rec = ExceptionPtrs.pExceptionRecord 'If Rec.pExceptionRecord is not zero, then it is a nested exception and Rec.pExceptionRecord points to another EXCEPTION_RECORD structure. Follow the pointers back to the original exception. Do Until Rec.pExceptionRecord = 0 CopyExceptionRecord Rec, Rec.pExceptionRecord, Len(Rec) Loop Beep 'Translate the exception code into a user-friendly string. ExceptionText = GetExceptionText(Rec.ExceptionCode) 'Turn Win32 error into normal VBA error Err.Raise Rec.ExceptionCode, "ExceptionFilter.UnhandledExceptionFilter", ExceptionText UnhandledExceptionFilter = EXCEPTION_CONTINUE_SEARCH
