home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Puzzle2082789102007.psc / modError.bas < prev    next >
BASIC Source File  |  2007-09-09  |  8KB  |  194 lines
  1. Attribute VB_Name = "modError"
  2. '
  3. '   *************************************************************************
  4. '   *************************************************************************
  5. '   ****                                                                 ****
  6. '   ****    Note:  "modError.bas" was created by "Mel Grubb II".         ****
  7. '   ****                                                                 ****
  8. '   ****    It came from the program called "FormShaper" which can be    ****
  9. '   ****    found at:                                                    ****
  10. '   ****                                                                 ****
  11. '   ****    http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=28524&lngWId=1
  12. '   ****                                                                 ****
  13. '   ****    Using it helped me to eliminate a couple of errors that I    ****
  14. '   ****    didn't previously know existed.                              ****
  15. '   ****                                                                 ****
  16. '   ****    Thank you Mel Grubb II.                                      ****
  17. '   ****                                                                 ****
  18. '   *************************************************************************
  19. '   *************************************************************************
  20. '
  21. '===============================================================================
  22. '   modError - Central error handling support module
  23. '   Provides centralized error handling and support for logging errors to the
  24. '   event log.
  25. '
  26. '   Version   Date        User            Notes
  27. '   1.0     11/16/00    Mel Grubb II    Initial version
  28. '   1.1     11/29/00    Mel Grubb II    Added error handlers
  29. '   Applied new coding standards
  30. '   1.2     09/05/01    Mel Grubb II    Added Trace command
  31. '   Removed Error enumerations
  32. '===============================================================================
  33.  
  34. Option Explicit
  35.  
  36. '===============================================================================
  37. '   Constants
  38. '===============================================================================
  39.  
  40. Private Const mc_strModuleID   As String = "modError."     'Used to identify the location of errors
  41.  
  42. '===============================================================================
  43. '   Global variables
  44. '===============================================================================
  45.  
  46. Private g_blnDebug             As Boolean   'Whether or not the program is in debug mode
  47.  
  48. '===============================================================================
  49. '   AppVersion - Standardize the formatting of the application version number
  50. '
  51. '   Arguments: None
  52. '
  53. '   Notes:
  54. '===============================================================================
  55.  
  56. Public Function AppVersion() As String
  57.  
  58.     On Error GoTo ExitHandler
  59.     AppVersion = App.Major & "." & Format$(App.Minor, "00") & "." & Format$(App.Revision, "0000")
  60.     Exit Function
  61.  
  62. ExitHandler:
  63.     AppVersion = "<Error>"
  64.  
  65. End Function
  66.  
  67. '==============================================================================
  68. '   ProcessError - Logs the specified error to the NT error log.
  69. '
  70. '   Parameters:
  71. '   objErr (IN) - the error to be logged
  72. '   ProcedureID (IN) - the module or method name where the error occurred.
  73. '   blnReraiseError (IN) - True if the error should be reraised; False otherwise.
  74. '
  75. '   Notes:
  76. '==============================================================================
  77.  
  78. Public Sub ProcessError(ByRef objErr As ErrObject, Optional ByVal ProcedureID As String, Optional ByVal blnReraiseError As Boolean = False)
  79.  
  80. Dim strMessage                 As String
  81. Dim strTitle                   As String
  82.  
  83.     On Error GoTo ExitHandler
  84. '   Build the simple error string for the dialog
  85.     strMessage = "Error Number = " & Err.Number & " (0x" & Hex$(Err.Number) & ")" & vbNewLine & _
  86.                  "Description = " & Err.Description & vbNewLine & _
  87.                  "Source = " & objErr.Source
  88.     If Len(ProcedureID) > 0 Then
  89.         strMessage = strMessage & vbNewLine & "Module = " & ProcedureID
  90.     End If
  91.     If Erl <> 0 Then
  92.         strMessage = strMessage & vbNewLine & "Line = " & Erl
  93.     End If
  94.  
  95. '   Show the error dialog
  96.     strTitle = App.Title & " [" & AppVersion() & "]"
  97.     MsgBox strMessage, vbOKOnly, strTitle
  98.  
  99. '   Expand the error before logging
  100.     strMessage = strTitle & vbNewLine & strMessage
  101.  
  102. '   Log the error to the event log or log file, and the debug window
  103.     App.LogEvent strMessage, vbLogEventTypeError
  104.     Debug.Print vbNewLine & strMessage
  105.  
  106. '   Reraise the error if necessary
  107.     If blnReraiseError Then
  108.         ReraiseError objErr, ProcedureID
  109.     End If
  110.  
  111. '   The next line will only be executed in Debug mode while in the IDE.
  112. '   It causes the application to stop so that the programmer can debug.
  113.     Debug.Assert StopInIDE() = True
  114.  
  115. ExitHandler:
  116. '   Release any screen locks
  117.     Screen.MousePointer = vbDefault
  118.  
  119. End Sub
  120.  
  121. '==============================================================================
  122. '   ReraiseError - reraises the specified error.
  123. '
  124. '   Parameters:
  125. '   objErr (IN) - the error to be reraised
  126. '   strModuleID (IN) - the module or method name where the error occurred.
  127. '
  128. '   Notes:
  129. '==============================================================================
  130.  
  131. Private Sub ReraiseError(objErr As ErrObject, Optional ByVal strModuleID As String = vbNullString)
  132.  
  133.     On Error Resume Next
  134.     If Len(strModuleID) > 0 Then
  135.         Err.Raise objErr.Number, strModuleID & vbNewLine & objErr.Source, objErr.Description, objErr.HelpFile, objErr.HelpContext
  136.     Else
  137.         Err.Raise objErr.Number, objErr.Source, objErr.Description, objErr.HelpFile, objErr.HelpContext
  138.     End If
  139.     On Error GoTo 0
  140.  
  141. End Sub
  142.  
  143. '===========================================================================
  144. '   StartLogging
  145. '===========================================================================
  146.  
  147. Public Sub StartLogging(ByVal LogTarget As String, LogMode As LogModeConstants)
  148.  
  149.     App.StartLogging LogTarget, LogMode
  150.  
  151. End Sub
  152.  
  153. '===========================================================================
  154. '   StopInIDE - Causes a stop, but only in development mode
  155. '
  156. '   Arguments: None
  157. '
  158. '   Notes:
  159. '===========================================================================
  160.  
  161. Private Function StopInIDE() As Boolean
  162.  
  163.     On Error GoTo ExitHandler
  164.     Stop
  165.     StopInIDE = True
  166.  
  167. ExitHandler:
  168.  
  169. End Function
  170.  
  171. '===============================================================================
  172. '   Trace - Adds statements to trace log
  173. '
  174. '   Arguments:
  175. '   Expression - String to append to trace log
  176. '
  177. '   Notes: Used to build a trace log in a finished executable since there is no
  178. '   debug window.  The trace log will be appended to the Error log in the event an
  179. '   error is trapped down the line.
  180. '
  181. '   g_blnDebug is checked here, but the calling application will probably benefit
  182. '   if it is also checked before any string concatenations are performed like this
  183. '   If g_blnDebug Then Trace "ProcName('" & Param1 & "')"
  184. '===============================================================================
  185.  
  186. Public Sub Trace(ByRef Expression As String)
  187.  
  188.     If g_blnDebug Then
  189.         Debug.Print Expression
  190.         App.LogEvent Expression, vbLogEventTypeInformation
  191.     End If
  192.  
  193. End Sub
  194.