modutilityerrorhandler.vb

软件用于升级SQL数据库

Imports System.Data
Imports System.Diagnostics
Imports UtilitySql

Module modUtilityErrorHandler

#Region "Declarations"
    Private Declare Sub Sleep Lib "kernel32" (ByVal intMilliseconds As Integer)
#End Region

#Region "Enumerations"
    Public Enum enumErrorLoggingMedium
        EventLog = 0
        SqlResult = 1
        MessageBox = 2
        LogFile = 3
        None = 4
    End Enum

    Public Enum enumEventLogType
        ApplicationLog = 1
        SystemLog = 2
    End Enum

    Public Enum enumEventLogSeverity
        ErrorEvent = 1
        InformationEvent = 2
        WarningEvent = 3
    End Enum
#End Region

#Region "Data"
    Private m_blnDisplayMsgBoxOnAllErrors As Boolean = False
    Private m_strConnectString As String = ""
    Private m_strDatabaseType As String = ""
    Private m_strLogFilePath As String = ""
    Private m_strLogFileName As String = ""
    Private m_strResultInsert As String = ""
#End Region

#Region "Public Routines"
    Public Sub WriteErrorInitialize(Optional ByVal strDatabaseType As String = "", _
        Optional ByVal strConnectString As String = "", _
        Optional ByVal strResultInsert As String = "", _
        Optional ByVal strLogFilePath As String = "", _
        Optional ByVal strLogFileName As String = "", _
        Optional ByVal blnDisplayMsgBoxOnAllErrors As Boolean = False)
        m_strDatabaseType = strDatabaseType
        m_strConnectString = strConnectString
        m_strResultInsert = strResultInsert
        m_strLogFilePath = strLogFilePath
        m_strLogFileName = strLogFileName
        m_blnDisplayMsgBoxOnAllErrors = blnDisplayMsgBoxOnAllErrors
    End Sub

    Public Sub WriteErrorLogEntry(ByVal intErrorLoggingMedium As enumErrorLoggingMedium, _
        ByVal strMessage As String, _
        Optional ByVal strSource As String = "", _
        Optional ByVal strKeys As String = "", _
        Optional ByVal blnInfoMessage As Boolean = False)
        '
        '   Handle an Error or Informational Message (Display, Event Log Write, Log File Write, or Sql Write)
        '
        Dim blnConnectError As Boolean
        Dim blnEventLog As Boolean
        Dim intLoggingMedium As enumErrorLoggingMedium
        Dim strErrorMsg As String = ""
        Dim strSqlStatement As String = ""
        Dim strValue As String = ""

        Try
            intLoggingMedium = intErrorLoggingMedium
            If intLoggingMedium = enumErrorLoggingMedium.SqlResult Then
                If m_strConnectString = "" _
                    Or m_strDatabaseType = "" _
                    Or m_strResultInsert = "" Then
                    intLoggingMedium = enumErrorLoggingMedium.EventLog
                End If
            End If
            Do
                Select Case intLoggingMedium
                    Case Is = enumErrorLoggingMedium.EventLog
                        blnEventLog = WriteEventLogEntry(enumEventLogType.ApplicationLog, CType(IIf(blnInfoMessage, enumEventLogSeverity.InformationEvent, enumEventLogSeverity.ErrorEvent), enumEventLogSeverity), strMessage)
                    Case Is = enumErrorLoggingMedium.SqlResult
                        strSqlStatement = Replace(m_strResultInsert, "%application%", My.Application.Info.Title.ToString())
                        strSqlStatement = Replace(strSqlStatement, "%datetime%", Format(Now, "MM/dd/yyyy hh:mm:ss tt"))
                        strSqlStatement = Replace(strSqlStatement, "%source%", Replace(CStr(IIf(strSource = "", "Error in " & My.Application.Info.Title.ToString(), strSource)), "'", ""))
                        strSqlStatement = Replace(strSqlStatement, "%message%", Replace(strMessage, "'", ""))
                        strSqlStatement = Replace(strSqlStatement, "%keys%", Replace(strKeys, "'", ""))
                        strSqlStatement = Replace(strSqlStatement, "%errorflag%", CStr(IIf(blnInfoMessage, "0", "1")))
                        strSqlStatement = Replace(strSqlStatement, "%handled%", CStr(IIf(blnInfoMessage, "1", "0")))
                        clsSql.ExecuteUpdate(m_strDatabaseType, _
                            m_strConnectString, _
                            CommandType.Text, _
                            strSqlStatement, _
                            strValue, _
                            strErrorMsg, _
                            blnConnectError)
                        If strErrorMsg <> "" Then
                            intLoggingMedium = enumErrorLoggingMedium.EventLog
                            blnEventLog = WriteEventLogEntry(enumEventLogType.ApplicationLog, enumEventLogSeverity.ErrorEvent, strMessage)
                            If Not blnInfoMessage Then
                                blnEventLog = WriteEventLogEntry(enumEventLogType.ApplicationLog, enumEventLogSeverity.ErrorEvent, strErrorMsg)
                            End If
                        End If
                    Case enumErrorLoggingMedium.LogFile
                        If m_strLogFilePath = "" Then
                            m_strLogFilePath = My.Application.Info.DirectoryPath
                        End If
                        If Right(m_strLogFilePath, 1) <> "\" Then
                            m_strLogFilePath &= "\"
                        End If
                        If m_strLogFileName = "" Then
                            m_strLogFileName = My.Application.Info.Title & ".log"
                        End If
                        My.Computer.FileSystem.WriteAllText(m_strLogFilePath & m_strLogFileName, _
                            Format$(Now, "mm/dd/yyyy  hh:nn tt") & "    " & _
                            My.Application.Info.Title.ToString() & "  " & _
                            My.Application.Info.Version.ToString() & _
                            CStr(IIf(blnInfoMessage, "Information", "Error")) & vbCrLf & vbCrLf & _
                            strMessage & vbCrLf & _
                            New String(CChar("="), 80) & vbCrLf, True)
                    Case Is = enumErrorLoggingMedium.MessageBox
                        If blnInfoMessage Then
                            MsgBox(strMessage, MsgBoxStyle.Information)
                        Else
                            MsgBox(strMessage, MsgBoxStyle.Critical)
                        End If
                End Select
                If intLoggingMedium = enumErrorLoggingMedium.EventLog _
                    And Not blnEventLog Then
                    intLoggingMedium = enumErrorLoggingMedium.LogFile
                ElseIf m_blnDisplayMsgBoxOnAllErrors _
                    And intLoggingMedium <> enumErrorLoggingMedium.MessageBox _
                    And intLoggingMedium <> enumErrorLoggingMedium.None Then
                    intLoggingMedium = enumErrorLoggingMedium.MessageBox
                Else
                    Exit Do
                End If
            Loop
            Return
        Catch objEx As Exception
        End Try
    End Sub

    Public Sub WriteErrorRoutine(ByVal intErrorLoggingMedium As enumErrorLoggingMedium, ByVal strClass As String, ByVal strRoutine As String, ByVal strErrorMsg As String)
        '
        '   Write an exception message from a try-catch block
        '
        Const strError As String = "Exception occurred in %application%.%class%.%routine%:  %errormsg%"

        Dim strMessage As String

        Try
            strMessage = Replace(strError, "%application%", My.Application.Info.Title())
            strMessage = Replace(strErrorMsg, "%class%", strClass)
            strMessage = Replace(strErrorMsg, "%routine%", strRoutine)
            strMessage = Replace(strErrorMsg, "%errormsg%", strErrorMsg)
            WriteErrorLogEntry(intErrorLoggingMedium, strMessage)
            Return
        Catch objEx As Exception
        End Try
    End Sub

    Public Function WriteEventLogEntry(ByVal intEventLogType As enumEventLogType, _
        ByVal intEventLogSeverity As enumEventLogSeverity, _
        ByVal strMessage As String) As Boolean

        Const enumMaxMessageLength As Integer = 1000

        Dim intSeverity As EventLogEntryType
        Dim objEventLog As EventLog
        Dim strAppName As String
        Dim strLogName As String

        Try
            If intEventLogType = enumEventLogType.SystemLog Then
                strLogName = "System"
            Else
                strLogName = "Application"
            End If
            strAppName = My.Application.Info.Title
            If Not EventLog.SourceExists(strAppName) Then
                EventLog.CreateEventSource(strAppName, strLogName)
                Sleep(100)
            End If
            objEventLog = New EventLog(strLogName)
            objEventLog.Source = strAppName
            If intEventLogSeverity = enumEventLogSeverity.InformationEvent Then
                intSeverity = EventLogEntryType.Information
            ElseIf intEventLogSeverity = enumEventLogSeverity.WarningEvent Then
                intSeverity = EventLogEntryType.Warning
            Else
                intSeverity = EventLogEntryType.Error
            End If
            objEventLog.WriteEntry(Left(strMessage, enumMaxMessageLength), intSeverity)
            Return True
        Catch objEx As Exception
            Return False
        End Try
    End Function
#End Region

End Module