Option Explicit On 
Option Strict Off
Option Compare Text


'=============================================================================================================
'
' cError.vb
' ---------
'
' Created By  : Kevin Wilson
'               http://www.TheVBZone.com   ( The VB Zone )
'               http://www.TheVBZone.net   ( The VB Zone .net )
'
' Last Update : July 23, 2003
' Created On  : July 23, 2003
'
' VB Versions : VB.NET 1.1 (VS.NET 2003)
'
' Requires    : The .NET Framework v1.1
'
' Description : This class module makes it easy to trap, record, and report errors as they occur from one
'               central location.
'
' Example Use :
'
'-------------------------------------------------------------------------------------------------------------
' THIS EXAPLE USES "Try...Catch"
'-------------------------------------------------------------------------------------------------------------
'
' Private oError As cError = New cError
' Private Sub Main_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
'    Dim oFile As System.IO.FileStream
'    ' Setup the error object to use throughout the application
'    oError = New cError(True, True, False, True, True, True, "C:\Error.log", "MyAppName")
'    Try
'       ' This next line causes an error because this file doesn't exist
'       oFile = System.IO.File.Open("C:\ASDLFKJLSDJFLSKDFJLSDF.ABC", IO.FileMode.Open)
'       oFile = Nothing
'    Catch Ex As Exception
'       Call oError.CheckError("Main_Load()", Ex)
'    End Try
' Exit Sub
'
'-------------------------------------------------------------------------------------------------------------
' THIS EXAPLE USES "On Error GoTo"
'-------------------------------------------------------------------------------------------------------------
'
' Private oError As cError = New cError
' Private Sub Main_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
' On Error GoTo ErrorTrap
'    Dim oFile As System.IO.FileStream
'    ' Setup the error object to use throughout the application
'    oError = New cError(True, True, False, True, True, True, "C:\Error.log", "MyAppName")
'    ' This next line causes an error because this file doesn't exist
'    oFile = System.IO.File.Open("C:\ASDLFKJLSDJFLSKDFJLSDF.ABC", IO.FileMode.Open)
'    oFile = Nothing
'    Exit Sub
' ErrorTrap:
'    Call oError.CheckError("Main_Load()", Err)
' End Sub
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyright© by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================


Public Class cError

#Region "Property Variables"

   Private m_bLogToEventLog As Boolean = True
   Private m_bLogToFile As Boolean = False
   Private m_bLogToEmail As Boolean = False
   Private m_bLogToDebug As Boolean = True
   Private m_bShowMsgBox As Boolean = True
   Private m_bBreakOnError As Boolean = False
   Private m_Email As cEmail = Nothing
   Private m_FilePath As String = ""
   Private m_EventName As String = "cError"
   Private m_EventComputerName As String = "."
   Private m_EventID As Integer = 0
   Private m_LastErrDate As Date = Nothing
   Private m_LastErrNum As Integer = 0
   Private m_LastErrLine As Integer = 0
   Private m_LastErrSrc As String = ""
   Private m_LastErrDesc As String = ""
   Private m_LastErrProc As String = ""
   Private m_LastErrStack As String = ""
   Private m_LastErrHelp As String = ""

#End Region

#Region "Constructors"

   Public Sub New()

   End Sub

   Public Sub New(ByVal bLogToEventLog As Boolean, _
                  ByVal bLogToFile As Boolean, _
                  ByVal bLogToEmail As Boolean, _
                  ByVal bLogToDebug As Boolean, _
                  ByVal bShowMsgBox As Boolean, _
                  ByVal bBreakOnError As Boolean, _
                  Optional ByVal sFilePath As String = "C:\ErrorLog.txt", _
                  Optional ByVal sEventName As String = "cError", _
                  Optional ByVal sEventComputer As String = ".")

      m_bLogToEventLog = bLogToEventLog
      m_bLogToFile = bLogToFile
      m_bLogToEmail = bLogToEmail
      m_bLogToDebug = bLogToDebug
      m_bShowMsgBox = bShowMsgBox
      m_bBreakOnError = bBreakOnError
      m_Email = New cEmail
      m_FilePath = sFilePath
      m_EventName = sEventName
      m_EventComputerName = sEventComputer

   End Sub

#End Region

#Region "Deconstructors"

   Protected Overrides Sub Finalize()

      m_Email = Nothing
      MyBase.Finalize()

   End Sub

#End Region

#Region "Public Properties"

   Public Property Log_EventLog() As Boolean
      Get
         Log_EventLog = m_bLogToEventLog
      End Get
      Set(ByVal Value As Boolean)
         m_bLogToEventLog = Value
      End Set
   End Property

   Public Property Log_File() As Boolean
      Get
         Log_File = m_bLogToFile
      End Get
      Set(ByVal Value As Boolean)
         m_bLogToFile = Value
      End Set
   End Property

   Public Property Log_Email() As Boolean
      Get
         Log_Email = m_bLogToEmail
      End Get
      Set(ByVal Value As Boolean)
         m_bLogToEmail = Value
      End Set
   End Property

   Public Property Log_DebugWindow() As Boolean
      Get
         Return m_bLogToDebug
      End Get
      Set(ByVal Value As Boolean)
         m_bLogToDebug = Value
      End Set
   End Property

   Public Property Log_ShowMsgBox() As Boolean
      Get
         Return m_bShowMsgBox
      End Get
      Set(ByVal Value As Boolean)
         m_bShowMsgBox = Value
      End Set
   End Property

   Public Property Break_On_Error() As Boolean

      Get
         Return m_bBreakOnError
      End Get
      Set(ByVal Value As Boolean)
         m_bBreakOnError = Value
      End Set

   End Property

   Public Property Email_SmtpServer() As String
      Get
         Return m_Email.SmtpServer
      End Get
      Set(ByVal Value As String)
         m_Email.SmtpServer = Value
      End Set
   End Property

   Public Property Email_From() As String
      Get
         Return m_Email.AddressFROM
      End Get
      Set(ByVal Value As String)
         m_Email.AddressFROM = Value
      End Set
   End Property

   '// TO can be a semicolon (;) delimited list of Email addresses, or a single Email address
   Public Property Email_To() As String
      Get
         Return m_Email.AddressTO
      End Get
      Set(ByVal Value As String)
         m_Email.AddressTO = Value
      End Set
   End Property

   '// CC can be a semicolon (;) delimited list of Email addresses, or a single Email address
   Public Property Email_CC() As String
      Get
         Return m_Email.AddressCC
      End Get
      Set(ByVal Value As String)
         m_Email.AddressCC = Value
      End Set
   End Property

   '// BCC can be a semicolon (;) delimited list of Email addresses, or a single Email address
   Public Property Email_BCC() As String
      Get
         Return m_Email.AddressBCC
      End Get
      Set(ByVal Value As String)
         m_Email.AddressBCC = Value
      End Set
   End Property

   Public Property Email_Subject() As String
      Get
         Return m_Email.Subject
      End Get
      Set(ByVal Value As String)
         m_Email.Subject = Value
      End Set
   End Property

   Public Property Email_Body() As String
      Get
         Return m_Email.Body
      End Get
      Set(ByVal Value As String)
         m_Email.Body = Value
      End Set
   End Property

   '// "Attachments" can be a semicolon (;) delimited list of file paths, or a single file path
   Public Property Email_Attachments() As String
      Get
         Return m_Email.Attachments
      End Get
      Set(ByVal Value As String)
         m_Email.Attachments = Value
      End Set
   End Property

   Public Property Email_Priority() As System.Web.Mail.MailPriority
      Get
         Return m_Email.Priority
      End Get
      Set(ByVal Value As System.Web.Mail.MailPriority)
         m_Email.Priority = Value
      End Set
   End Property

   Public Property Email_Format() As System.Web.Mail.MailFormat
      Get
         Return m_Email.Format
      End Get
      Set(ByVal Value As System.Web.Mail.MailFormat)
         m_Email.Format = Value
      End Set
   End Property

   Public Property EventLog_Name() As String
      Get
         Return m_EventName
      End Get
      Set(ByVal Value As String)
         m_EventName = Value
      End Set
   End Property

   Public Property EventLog_ComputerName() As String
      Get
         Return m_EventComputerName
      End Get
      Set(ByVal Value As String)
         m_EventComputerName = Value
      End Set
   End Property

   Public Property EventLog_EventID() As String
      Get
         Return m_EventID
      End Get
      Set(ByVal Value As String)
         m_EventID = Value
      End Set
   End Property

#End Region

#Region "Public Methods"

   '// Gets the error information from a "Try...Catch" exception object
   Public Overloads Function CheckError(ByVal sProcedure As String, ByRef oException As Exception) As Boolean

      m_LastErrDate = Now
      m_LastErrProc = sProcedure
      m_LastErrNum = -1 '// No error number is returned by the "Exception" object
      m_LastErrSrc = oException.Source
      m_LastErrDesc = oException.Message
      m_LastErrStack = oException.StackTrace
      m_LastErrLine = GetErrorLineFromStackTrace(m_LastErrStack)
      m_LastErrHelp = oException.HelpLink

      If m_LastErrSrc = "" And m_LastErrDesc = "" Then
         Call ClearLastError()
         Return False '// No Error occured
      End If
      CheckError = True

      Call DoLogs()

      If m_bBreakOnError = True Then Stop

   End Function

   '// Gets the error information from an "On Error GoTo" Err object
   Public Overloads Function CheckError(ByVal sProcedure As String, ByRef oErr As ErrObject) As Boolean

      m_LastErrDate = Now
      m_LastErrProc = sProcedure
      m_LastErrNum = oErr.Number
      m_LastErrSrc = oErr.Source
      m_LastErrDesc = oErr.Description
      m_LastErrStack = oErr.GetException.StackTrace
      m_LastErrLine = oErr.Erl
      If m_LastErrLine = 0 Then m_LastErrLine = GetErrorLineFromStackTrace(m_LastErrStack)
      m_LastErrHelp = oErr.GetException.HelpLink & " [" & oErr.HelpFile & " (" & oErr.HelpContext.ToString & ")]"
      If m_LastErrHelp = " [ (0)]" Or m_LastErrHelp = "#0 [ (0)]" Then m_LastErrHelp = ""
      Call Err.Clear()

      If m_LastErrNum = 0 And m_LastErrDesc = "" Then
         Call ClearLastError()
         Return False '// No Error occured
      End If
      CheckError = True

      Call DoLogs()

      If m_bBreakOnError = True Then Stop

   End Function

   '// Gets the error information from a specified error.  Call the following to pass in
   '// the "sStackTrace" parameter: System.Environment.StackTrace.ToString
   Public Overloads Function CheckError(ByVal sProcedure As String, _
                                        Optional ByVal iErrNum As Integer = 0, _
                                        Optional ByVal sErrSrc As String = "", _
                                        Optional ByVal sErrDesc As String = "", _
                                        Optional ByVal iErrLine As Integer = 0, _
                                        Optional ByVal sErrHelp As String = "", _
                                        Optional ByVal sStackTrace As String = "") As Boolean

      m_LastErrDate = Now
      m_LastErrProc = sProcedure
      m_LastErrNum = iErrNum
      m_LastErrSrc = sErrSrc
      m_LastErrDesc = sErrDesc
      m_LastErrStack = sStackTrace
      m_LastErrLine = iErrLine
      If m_LastErrLine = 0 Then m_LastErrLine = GetErrorLineFromStackTrace(m_LastErrStack)
      m_LastErrHelp = sErrHelp
      Call Err.Clear()

      If m_LastErrNum = 0 And m_LastErrDesc = "" Then
         Call ClearLastError()
         Return False '// No Error occured
      End If
      CheckError = True

      Call DoLogs()

      If m_bBreakOnError = True Then Stop

   End Function

   '// Returns back the error information from the last error that occured
   Public Function GetLastError(Optional ByRef Return_ErrDate As Object = Nothing, _
                                Optional ByRef Return_ErrNum As Integer = 0, _
                                Optional ByRef Return_ErrSrc As String = "", _
                                Optional ByRef Return_ErrDesc As String = "", _
                                Optional ByRef Return_ErrLine As Integer = 0, _
                                Optional ByRef Return_ErrProcedure As String = "", _
                                Optional ByRef Return_StackTrace As String = "", _
                                Optional ByRef Return_HelpLink As String = "") As Boolean

      Return_ErrDate = m_LastErrDate
      Return_ErrNum = m_LastErrNum
      Return_ErrLine = m_LastErrLine
      Return_ErrSrc = m_LastErrSrc
      Return_ErrDesc = m_LastErrDesc
      Return_ErrProcedure = m_LastErrProc
      Return_StackTrace = m_LastErrStack
      Return_HelpLink = m_LastErrHelp

      If m_LastErrSrc = "" And m_LastErrDesc = "" Then
         GetLastError = False
      Else
         GetLastError = True
      End If

   End Function

   '// Clears the last error that occured
   Public Sub ClearLastError()

      m_LastErrDate = Nothing
      m_LastErrNum = 0
      m_LastErrLine = 0
      m_LastErrSrc = ""
      m_LastErrDesc = ""
      m_LastErrProc = ""
      m_LastErrStack = ""
      m_LastErrHelp = ""

   End Sub

   '// Returns the error information in a formatted manner that is easy to read
   Public Function FormatLastError() As String

      FormatLastError = StrDup(50, "=") & vbCrLf & _
                        " Date = " & m_LastErrDate.ToString & vbCrLf & _
                        " Number = " & m_LastErrNum.ToString & vbCrLf & _
                        " Source = " & m_LastErrSrc & vbCrLf & _
                        " Procedure = " & m_LastErrProc & vbCrLf & _
                        " Line Number = " & m_LastErrLine.ToString & vbCrLf & _
                        " Help Link = " & m_LastErrHelp & vbCrLf & _
                        " Description = " & m_LastErrDesc & vbCrLf & _
                        " Stack Trace:" & vbCrLf & m_LastErrStack & vbCrLf & _
                        StrDup(50, "=") & vbCrLf

   End Function

#End Region

#Region "Local Helper Functions"

   '// Saves the error to file
   Private Function SaveToFile(ByVal sText As String, _
                               Optional ByRef Return_ErrNum As Integer = 0, _
                               Optional ByRef Return_ErrSrc As String = "", _
                               Optional ByRef Return_ErrDesc As String = "") As Boolean
      On Error GoTo ErrorTrap

      Dim oFile As System.IO.FileStream
      Dim oEncoder As System.Text.Encoding
      Dim arrInfo() As Byte

      '// Convert the string to write into a BYTE array
      oEncoder = System.Text.Encoding.Default
      arrInfo = oEncoder.GetBytes(sText)

      '// Open the file
      If System.IO.File.Exists(m_FilePath) = True Then
         oFile = System.IO.File.Open(m_FilePath, IO.FileMode.Append, IO.FileAccess.Write)
      Else
         oFile = System.IO.File.Create(m_FilePath)
      End If

      '// Write the text to the file
      oFile.Write(arrInfo, 0, arrInfo.Length)
      oFile.Close()

      '// Clean up
      oEncoder = Nothing
      oFile = Nothing
      Return True

ErrorTrap:

      Return_ErrNum = Err.Number
      Return_ErrSrc = Err.Source
      Return_ErrDesc = Err.Description
      Err.Clear()
      If Not oFile Is Nothing Then
         oFile.Close()
         oFile = Nothing
      End If

   End Function

   '// Shows the error message to you
   Private Sub ShowMsgBox()

      Dim strProc As String

      If m_LastErrProc = "" Then
         strProc = "current"
      Else
         strProc = Chr(34) & m_LastErrProc & Chr(34)
      End If

      MsgBox("The following error just occured in the " & strProc & " procedure:" & Chr(13) & Chr(13) & _
             "Error Number = " & m_LastErrNum.ToString & Chr(13) & _
             "Error Source = " & m_LastErrSrc & Chr(13) & _
             "Error Line = " & m_LastErrLine & Chr(13) & _
             "Error Description = " & m_LastErrDesc, MsgBoxStyle.OKOnly Or MsgBoxStyle.Exclamation, "  Error")

   End Sub

   '// Writes the error message to the DEBUG / OUTPUT window
   Private Sub WriteOutDebug()

      Dim strProc As String

      If m_LastErrProc = "" Then
         strProc = "current"
      Else
         strProc = Chr(34) & m_LastErrProc & Chr(34)
      End If

      Debug.WriteLine("")
      Debug.WriteLine(" * The following error just occured in the " & strProc & " procedure:")
      Debug.WriteLine(" *   Error Number = " & m_LastErrNum.ToString)
      Debug.WriteLine(" *   Error Source = " & m_LastErrSrc)
      Debug.WriteLine(" *   Error Line = " & m_LastErrLine)
      Debug.WriteLine(" *   Error Description = " & m_LastErrDesc)
      Debug.WriteLine(" *   Stack Trace:")
      Debug.WriteLine(m_LastErrStack)
      Debug.WriteLine("")

   End Sub

   '// Parses out the error line number from the specified StackTrace
   Private Function GetErrorLineFromStackTrace(ByVal sStackTrace As String) As Integer

      Const SEARCH_STRING As String = ":line "
      Dim strTemp As String
      Dim iPos As Integer

      If Trim(sStackTrace) = "" Then Return 0

      '// Attemp to get the line number from the StackTrace
      iPos = InStrRev(sStackTrace, SEARCH_STRING, -1, CompareMethod.Text)
      If iPos > 0 Then
         strTemp = Mid(sStackTrace, iPos + SEARCH_STRING.Length)
         If IsNumeric(strTemp) = True Then
            GetErrorLineFromStackTrace = CInt(strTemp)
         Else
            GetErrorLineFromStackTrace = 0
         End If
      Else
         GetErrorLineFromStackTrace = 0
      End If

   End Function

   '// Does the logging specified by the user
   Private Sub DoLogs()

      Dim strTemp As String
      Dim strFormatted As String

      ' Get the formatted error message to use
      strFormatted = FormatLastError()

      ' Debug Window
      If m_bLogToDebug = True Then
         WriteOutDebug()
      End If

      ' Send Email
      If m_bLogToEmail = True Then
         strTemp = m_Email.Body 'Remember the original BODY text
         If m_Email.Format = Web.Mail.MailFormat.Html Then
            m_Email.Body = strTemp & vbCrLf & vbCrLf & Replace(Replace(strFormatted, vbCrLf, "<br />"), Chr(34), "&quot;")
         Else
            m_Email.Body = strTemp & vbCrLf & vbCrLf & strFormatted
         End If
         m_Email.SendEmailEx()
         m_Email.Body = strTemp 'Restore the original BODY text
      End If

      ' Event Log
      If m_bLogToEventLog = True Then
         cEventLog.LogEvent(strFormatted, m_EventName, m_EventComputerName, m_EventID, cEventLog.LogTypes.Application, EventLogEntryType.Error)
      End If

      ' Write to file
      If m_bLogToFile = True Then
         SaveToFile(strFormatted)
      End If

      ' Show message box
      If m_bShowMsgBox = True Then
         ShowMsgBox()
      End If

   End Sub

#End Region

End Class