Module: Option Explicit
Public const eXception_maximum_parameters = 15
'----------------------------' Exception-Handling Structures' -------------- --------------- Type Exception_Pointers PEXCEPTIONRECORD AS Long 'Pointer to an Exception_Record Struct PCONTEXTRECORD AS Long' Pointer To a Context Structend Type
Type EXCEPTION_RECORD ExceptionCode As Long ExceptionFlags As Long pExceptionRecord As Long 'Pointer to an EXCEPTION_RECORD structure ExceptionAddress As Long NumberParameters As Long ExceptionInformation (EXCEPTION_MAXIMUM_PARAMETERS) As LongEnd Type
'--------------------------------------- ------------- 'Set lpTopLevelExceptionFilter parameter to AddressOf
Declare Function getExceptioncode lib "kernel32" () AS Long
'Returns a Pointer to an Exception_Pointers StructureDeclare Function getExceptioninformation LIB "kernel32" () AS Long
'NOT Used in this ExampleClare Function RaiseException Lib "Kernel32" (_ DWExceptioncode As Long, _ DwexceptionFlags As Long, _ nnumberofarguments as long, _ lparguments as long _) As long
Declare sub copymemory lib "kernel32" Alias "RTLMoveMemory" (_ lpvdest as any, lpvsource as any, byval cbcopy as ring)
Public Function GetException (Vvalue As Variant) AS STRING
'Function Returns Name of Constant for Given Value.
DIM sname as string
Select Case vvalue
Case & HC0000005 sName = "EXCEPTION_ACCESS_VIOLATION" Case & HC000008C sName = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED" Case & H80000003 sName = "EXCEPTION_BREAKPOINT" Case -1 sName = "EXCEPTION_CONTINUE_EXECUTION" Case 0 sName = "EXCEPTION_CONTINUE_SEARCH" Case & H80000002 sName = "EXCEPTION_DATATYPE_MISALIGNMENT" Case 1 sName = "EXCEPTION_DEBUG_EVENT" Case 1 sName = "EXCEPTION_EXECUTE_HANDLER" Case & HC000008D sName = "EXCEPTION_FLT_DENORMAL_OPERAND" Case & HC000008E sName = "EXCEPTION_FLT_DIVIDE_BY_ZERO" Case & HC000008F sName = "EXCEPTION_FLT_INEXACT_RESULT" Case & HC0000090 sName = "EXCEPTION_FLT_INVALID_OPERATION" Case & HC0000091 sName = "EXCEPTION_FLT_OVERFLOW" Case & HC0000092 sName = "EXCEPTION_FLT_STACK_CHECK" Case & Hc0000093 Sname = "Exception_flt_underflow" Case & H80000001 Sname = "Exception_guard_page" Case & HC000001D Sname = "Exception_illegal_instruction" case & hc000000 6 sName = "EXCEPTION_IN_PAGE_ERROR" Case & HC0000094 sName = "EXCEPTION_INT_DIVIDE_BY_ZERO" Case & HC0000095 sName = "EXCEPTION_INT_OVERFLOW" Case & HC0000026 sName = "EXCEPTION_INVALID_DISPOSITION" Case & HC0000008 sName = "EXCEPTION_INVALID_HANDLE" Case 15 sName = "EXCEPTION_MAXIMUM_PARAMETERS" Case & HC0000025 sName = "
EXCEPTION_NONCONTINUABLE_EXCEPTION "Case & HC0000096 sName =" EXCEPTION_PRIV_INSTRUCTION "Case & H80000004 sName =" EXCEPTION_SINGLE_STEP "Case & HC00000FD sName =" EXCEPTION_STACK_OVERFLOW "Case Else sName ="
GetException = SNAME
END FUNCTION
'This function receivers the address of an exception_pointers structure in its parameterfunction newexceptionhandler (byref lpexception) as long
'No need to return a value since err.raise Will ALTER EXECUTION FLOW
Dim Er as Exception_Recorddim Serror As String
'Make a Copy of the Exception Record Portion' of the passed-in Exception_Pointers StructurePoPyMemory ER, BYVAL LPEXCEPTIONPOINTERS.PEXCEPTIONRECORD, LEN (ER)
'Set up error description stringDo sError = GetException (er.ExceptionCode)' Special treatment for access violation - get addresses If sError = "EXCEPTION_ACCESS_VIOLATION" Then sError = sError & "- Instr @ & H" & Hex (er.ExceptionAddress) _ & "Tried Illegally to" _ & Iif (Er.Exceptioninformation (0) = 0, "Read from Address", "Write to Address") _ & "& H" & HEX (Er.Exceptioninformation (1)) end if 'Check for nested error If er.pExceptionRecord = 0 Then Exit Do 'nested error exists' Replace this er by the nested er CopyMemory er, ByVal er.pExceptionRecord, Len (er) 'New line for next error sError = sError & vbCrLfLoop' Raise an error To Go Up The Call Stack, Passing The External Generated Error! Err.raise 1000, "NewexceptionHandler", Serrorend Function
Form: Option Explicit
Private subclicraiseexception_click ()
DIM LPDEST AS Longdim LNG As Long
ON Error Goto Err_RaiseException
LNG = 5
CopyMemory Byval Lpdest, ByVal Varptr (LNG), 1
MSGBOX "Recovered from GPF"
EXIT SUBERR_RAISEEXCEPTION: MSGBOX Err.Description Resume Nextend Sub
Sub setHandler () SetunHandledExceptionFilter Addressof NewExceptionHandlerend Sub
Sub restoreHandler () setunhandledExceptionFilter 0nd Sub
Private Sub Form_Load () setHandlerend Sub
Private Sub Form_Unload (Cancel As Integer) RestoreHandlend Sub
