Tweet
11/02/2009: changed to ExitProcess(); thanks to Mike Stefanik
11/02/2009
added sample class & and test code for the class
with %ErrHaltActive defined
- you'll get a message of where the error occurred;
source file, class, interface, method/procedure, message
this is really aimed at classes and low-level include files
you write a little test program to call all the methods in the class
define %ErrHaltActive in the test app
any errors will be pinpointed
may be used for contract style programming;
if this <> that then Err_Set(....) 'displays message if %ErrHaltActive defined
I got rid of the evil !HLT, thanks to Mike Stefanik for pointing me in the right direction
this may be used like Assert(c, c++) by defining %ErrHaltActive during development phase.
IF p = %NULL THEN Err_Set(...)
application will stop at point of error with; source file, class, interface, procedure and message
11/02/2009
added sample class & and test code for the class
with %ErrHaltActive defined
- you'll get a message of where the error occurred;
source file, class, interface, method/procedure, message
this is really aimed at classes and low-level include files
you write a little test program to call all the methods in the class
define %ErrHaltActive in the test app
any errors will be pinpointed
may be used for contract style programming;
if this <> that then Err_Set(....) 'displays message if %ErrHaltActive defined
I got rid of the evil !HLT, thanks to Mike Stefanik for pointing me in the right direction
this may be used like Assert(c, c++) by defining %ErrHaltActive during development phase.
IF p = %NULL THEN Err_Set(...)
application will stop at point of error with; source file, class, interface, procedure and message
Code:
'PB 5/9 .02
'Error.inc
'
' 11/02/2009: changed to ExitProcess(); thanks to Mike Stefanik
'
' error trapping and message handling functions
'
' !!! %ErrHaltActive should only be defined: test/debug phase !!!
'
' if, %ErrHaltActive is defined: %ErrHaltActive = 1
' FatalAppExit() will be called
' displays message box
' - display error number
' - display error source file
' - display Class, Interface, Procedure
' - display error message
'
'to use for error trapping, ErrT has to be global (bad ideal) or passed to every procedure.
'SUB MySub(e as ErrT)
' IF e.err = %false then
' 'code
' END IF
'END SUB
'
'at any point, you may catch and clear the error; Err_Clear(e)
'
' for full error protection - you have to retest ErrT after calling any procedure that might cause an error
'
#If Not %Def(%WINAPI)
#Include Once "WIN32API.INC"
#EndIf
'
' you can use your own error codes
' "no error" has to equal zero
' you can also ignore the error codes and just use a string message
'
%ErrNone = 0
%ErrUndefined = -1
'
Type ErrT
Err As Long
file As Asciiz * 256
Class As Asciiz * 256
Interface As Asciiz * 256
procedure As Asciiz * 256
message As Asciiz * 256
End Type
'
Sub Err_Clear(e As ErrT, ByVal clearCritical As Long)
'reset error status
e.err = %ErrNone
End Sub
'
Sub Err_Set( _
e As ErrT, _
ByVal errNo As Long, _ 'error number
ByVal errFile As String, _ 'source file
ByVal errClass As String, _ 'class error occurred in
ByVal errInterface As String, _ 'interface error occurred in
ByVal errProcedure As String, _ 'Function/Sub/Method/Property error occurred in
ByVal errMessage As String _ 'error message
)
'
'set error
' program will halt if %ErrHaltActive is defined [ %ErrHaltActive = 1 ]
'
e.err = IIf&(errNo, errNo, %ErrUndefined)
e.file = errFile
e.class = errClass
e.interface = errInterface
e.procedure = errProcedure
e.message = errMessage
Local t As String
t = "Fatal Error!"
Local s As String
s = "Error: " + Format$(e.err) +": "+ e.file +": "+ e.class +": "+ e.interface +": "+ e.procedure +": "+ e.message
#If %Def(%ErrHaltActive)
MessageBox(0, ByVal StrPtr(s), ByVal StrPtr(t), %MB_Ok Or %MB_IconWarning Or %MB_ApplModal)
'''''''FatalAppExit(%null, ByVal StrPtr(s))
'''''''''DebugBreak()
ExitProcess(%null)
#Else
#Debug Print s
#EndIf
End Sub
'
Function Err_Get(e As ErrT) As Long
'get error status - null if no error
Function = e.err
End Function
'
Function Err_Message(e As ErrT) As String
'get error message
If e.err Then Function = e.message
End Function
'
Function Err_FullMessage(e As ErrT) As String
'get full error message
If e.err Then
Local s As String
s = "Error: " + Format$(e.err) +": "+ e.file +": "+ e.class +": "+ e.interface +": "+ e.procedure +": "+ e.message
Function = s
End If
End Function
'
Comment