ErrObject.vb

' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.

Imports Microsoft.VisualBasic.CompilerServices
Imports Microsoft.VisualBasic.CompilerServices.Utils

Imports System
Imports System.Runtime.InteropServices

Namespace Microsoft.VisualBasic

    Public NotInheritable Class ErrObject

        ' Error object private values
        Private m_curException As Exception
        Private m_curErl As Integer
        Private m_curNumber As Integer
        Private m_curDescription As String
        Private m_NumberIsSet As Boolean
        Private m_ClearOnCapture As Boolean
        Private m_DescriptionIsSet As Boolean

        Private m_curSource As String
        Private m_SourceIsSet As Boolean
        Private m_curHelpFile As String
        Private m_curHelpContext As Integer
        Private m_HelpFileIsSet As Boolean
        Private m_HelpContextIsSet As Boolean

        Friend Sub New()
            Me.Clear() 'need to do this so the fields are set to Empty string, not Nothing
        End Sub

        '============================================================================
        ' ErrObject functions.
        '============================================================================
        Public ReadOnly Property Erl() As Integer
            Get
                Return m_curErl
            End Get
        End Property

        Public Property Number() As Integer
            Get
                If m_NumberIsSet Then
                    Return m_curNumber
                End If

                If Not m_curException Is Nothing Then
                    Me.Number = MapExceptionToNumber(m_curException)
                    Return m_curNumber
                Else
                    'The default case.  NOTE:  falling into the default does not "Set" the property.
                    'We only get here if the Err object was previously cleared.
                    Return 0
                End If
            End Get

            Set(ByVal Value As Integer)
                m_curNumber = MapErrorNumber(Value)
                m_NumberIsSet = True
            End Set
        End Property

        Public Property Source() As String
            Get
                'Return the current Source if we've already calculated it.
                If m_SourceIsSet Then
                    Return m_curSource
                End If

                If Not m_curException Is Nothing Then
                    Me.Source = m_curException.Source
                    Return m_curSource
                Else
                    'The default case.  NOTE:  falling into the default does not "Set" the property.
                    'We only get here if the Err object was previously cleared.
                    '
                    Return ""
                End If
            End Get

            Set(ByVal Value As String)
                m_curSource = Value
                m_SourceIsSet = True
            End Set
        End Property

        ''' <summary>
        ''' Determines what the correct error description should be.
        ''' If we don't have an exception that we are responding to then
        ''' we don't do anything to the message.
        ''' If we do have an exception pending, we morph the description
        ''' to match the corresponding VB error.
        ''' We also special case HRESULT exceptions to map to a VB description
        ''' if we have one.
        ''' </summary>
        ''' <param name="Msg"></param>
        ''' <returns></returns>
        Private Function FilterDefaultMessage(ByVal Msg As String) As String
            Dim NewMsg As String

            'This is one of the default messages,
            If m_curException Is Nothing Then
                'Leave message as is
                Return Msg
            End If

            Dim tmpNumber As Integer = Me.Number

            If Msg Is Nothing OrElse Msg.Length = 0 Then
                Msg = SR.GetResourceString("ID" & CStr(tmpNumber))
            ElseIf System.String.CompareOrdinal("Exception from HRESULT: 0x", 0, Msg, 0, Math.Min(Msg.Length, 26)) = 0 Then
                NewMsg = SR.GetResourceString("ID" & CStr(m_curNumber))
                If Not NewMsg Is Nothing Then
                    Msg = NewMsg
                End If
            End If

            Return Msg
        End Function

        Public Property Description() As String
            Get
                If m_DescriptionIsSet Then
                    Return m_curDescription
                End If

                If Not m_curException Is Nothing Then
                    Me.Description = FilterDefaultMessage(m_curException.Message)
                    Return m_curDescription
                Else
                    'The default case.  NOTE:  falling into the default does not "Set" the property.
                    'We only get here if the Err object was previously cleared.
                    Return ""
                End If
            End Get

            Set(ByVal Value As String)
                m_curDescription = Value
                m_DescriptionIsSet = True
            End Set
        End Property

        Public Property HelpFile() As String
            Get
                If m_HelpFileIsSet Then
                    Return m_curHelpFile
                End If

                If Not m_curException Is Nothing Then
                    ParseHelpLink(m_curException.HelpLink)
                    Return m_curHelpFile
                Else
                    'The default case.  NOTE:  falling into the default does not "Set" the property.
                    'We only get here if the Err object was previously cleared.
                    '
                    Return ""
                End If
            End Get

            Set(ByVal Value As String)
                m_curHelpFile = Value

                m_HelpFileIsSet = True
            End Set
        End Property

        Private Function MakeHelpLink(ByVal HelpFile As String, ByVal HelpContext As Integer) As String
            Return HelpFile & "#" & CStr(HelpContext)
        End Function

        Private Sub ParseHelpLink(ByVal HelpLink As String)

            Diagnostics.Debug.Assert((Not m_HelpContextIsSet) OrElse (Not m_HelpFileIsSet), "Why is this getting called?")

            If HelpLink Is Nothing OrElse HelpLink.Length = 0 Then

                If Not m_HelpContextIsSet Then
                    Me.HelpContext = 0
                End If
                If Not m_HelpFileIsSet Then
                    Me.HelpFile = ""
                End If

            Else

                Dim iContext As Integer = m_InvariantCompareInfo.IndexOf(HelpLink, "#", Globalization.CompareOptions.Ordinal)

                If iContext <> -1 Then
                    If Not m_HelpContextIsSet Then
                        If iContext < HelpLink.Length Then
                            Me.HelpContext = CInt(HelpLink.Substring(iContext + 1))
                        Else
                            Me.HelpContext = 0
                        End If
                    End If
                    If Not m_HelpFileIsSet Then
                        Me.HelpFile = HelpLink.Substring(0, iContext)
                    End If
                Else
                    If Not m_HelpContextIsSet Then
                        Me.HelpContext = 0
                    End If
                    If Not m_HelpFileIsSet Then
                        Me.HelpFile = HelpLink
                    End If
                End If

            End If

        End Sub

        Public Property HelpContext() As Integer
            Get
                If m_HelpContextIsSet Then
                    Return m_curHelpContext
                End If

                If Not m_curException Is Nothing Then
                    ParseHelpLink(m_curException.HelpLink)
                    Return m_curHelpContext

                Else
                    'The default case.  NOTE:  falling into the default does not "Set" the property.
                    'We only get here if the Err object was previously cleared.
                    '
                    Return 0
                End If

                Return m_curHelpContext
            End Get

            Set(ByVal Value As Integer)
                m_curHelpContext = Value
                m_HelpContextIsSet = True
            End Set
        End Property

        Public Function GetException() As Exception
            Return m_curException
        End Function

        ''' <summary>
        ''' VB calls clear whenever it executes any type of Resume statement, Exit Sub, Exit function, exit Property, or
        ''' any On Error statement.
        ''' </summary>
        Public Sub Clear()
            m_curException = Nothing
            m_curNumber = 0
            m_curSource = ""
            m_curHelpFile = ""
            m_curHelpContext = 0
            m_SourceIsSet = False
            m_HelpFileIsSet = False
            m_HelpContextIsSet = False
            m_curDescription = ""
            m_curErl = 0
            m_NumberIsSet = False
            m_DescriptionIsSet = False
            m_ClearOnCapture = True
        End Sub

        ''' <summary>
        ''' This function is called when the Raise code command is executed
        ''' </summary>
        ''' <param name="Number">The error code being raised</param>
        ''' <param name="Source">If not supplied we take the name from the assembly</param>
        ''' <param name="Description">If not supplied, we try to look one up based on the error code being raised</param>
        ''' <param name="HelpFile"></param>
        ''' <param name="HelpContext"></param>
        Public Sub Raise(ByVal Number As Integer,
                         Optional ByVal Source As Object = Nothing,
                         Optional ByVal Description As Object = Nothing,
                         Optional ByVal HelpFile As Object = Nothing,
                         Optional ByVal HelpContext As Object = Nothing)

            If Number = 0 Then
                'This is only called by Raise, so Raise(0) should give the following exception
                Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Number"))
            End If
            Me.Number = Number

            If Not Source Is Nothing Then
                Me.Source = CStr(Source)
            Else
                ' .NET Framework uses VBHost.GetWindowTitle() if available
                ' but the VBHost type is not accessible here.
                Dim FullName As String
                Dim CommaPos As Integer

                FullName = System.Reflection.Assembly.GetCallingAssembly().FullName
                CommaPos = InStr(FullName, ",")
                If CommaPos < 1 Then
                    Me.Source = FullName
                Else
                    Me.Source = Left(FullName, CommaPos - 1)
                End If
            End If

            If Not HelpFile Is Nothing Then
                Me.HelpFile = CStr(HelpFile)
            End If

            If Not HelpContext Is Nothing Then
                Me.HelpContext = CInt(HelpContext)
            End If

            If Not Description Is Nothing Then
                Me.Description = CStr(Description)
            ElseIf Not m_DescriptionIsSet Then
                'Set the Description here so the exception object contains the right message
                Me.Description = GetResourceString(CType(m_curNumber, vbErrors))
            End If

            Dim e As Exception
            e = MapNumberToException(m_curNumber, m_curDescription)
            e.Source = m_curSource
            e.HelpLink = MakeHelpLink(m_curHelpFile, m_curHelpContext)
            m_ClearOnCapture = False
            Throw e
        End Sub

        ReadOnly Property LastDllError() As Integer
            Get
                Return Marshal.GetLastWin32Error()
            End Get
        End Property

        Friend Sub SetUnmappedError(ByVal Number As Integer)
            Me.Clear()
            Me.Number = Number
            m_ClearOnCapture = False
        End Sub

        'a function like this that can be used by the runtime to generate errors which will also do a clear would be nice.
        Friend Function CreateException(ByVal Number As Integer, ByVal Description As String) As System.Exception
            Me.Clear()
            Me.Number = Number

            If Number = 0 Then
                'This is only called by Error xxxx, zero is not a valid exception number
                Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Number"))
            End If

            Dim e As Exception = MapNumberToException(m_curNumber, Description)
            m_ClearOnCapture = False
            Return e
        End Function

        Friend Overloads Sub CaptureException(ByVal ex As Exception)
            'if we've already captured this exception, then we're done
            If ex IsNot m_curException Then
                If m_ClearOnCapture Then
                    Me.Clear()
                Else
                    m_ClearOnCapture = True   'False only used once - set this flag back to the default
                End If
                m_curException = ex
            End If
        End Sub

        Friend Overloads Sub CaptureException(ByVal ex As Exception, ByVal lErl As Integer)
            CaptureException(ex)
            m_curErl = lErl  'This is the only place where the line number can be set
        End Sub

        Private Function MapExceptionToNumber(ByVal e As Exception) As Integer
            Diagnostics.Debug.Assert(e IsNot Nothing, "Exception shouldn't be Nothing")
            Dim typ As Type = e.GetType()

            If typ Is GetType(System.IndexOutOfRangeException) Then
                Return vbErrors.OutOfBounds
            ElseIf typ Is GetType(System.RankException) Then
                Return vbErrors.OutOfBounds
            ElseIf typ Is GetType(System.DivideByZeroException) Then
                Return vbErrors.DivByZero
            ElseIf typ Is GetType(System.OverflowException) Then
                Return vbErrors.Overflow
            ElseIf typ Is GetType(System.NotFiniteNumberException) Then
                Dim exNotFiniteNumber As NotFiniteNumberException = CType(e, NotFiniteNumberException)
                If exNotFiniteNumber.OffendingNumber = 0 Then
                    Return vbErrors.DivByZero
                Else
                    Return vbErrors.Overflow
                End If
            ElseIf typ Is GetType(System.NullReferenceException) Then
                Return vbErrors.ObjNotSet
            ElseIf TypeOf e Is System.AccessViolationException Then
                Return vbErrors.AccessViolation
            ElseIf typ Is GetType(System.InvalidCastException) Then
                Return vbErrors.TypeMismatch
            ElseIf typ Is GetType(System.NotSupportedException) Then
                Return vbErrors.TypeMismatch
            ElseIf typ Is GetType(System.Runtime.InteropServices.SEHException) Then
                Return vbErrors.DLLCallException
            ElseIf typ Is GetType(System.DllNotFoundException) Then
                Return vbErrors.FileNotFound
            ElseIf typ Is GetType(System.EntryPointNotFoundException) Then
                Return vbErrors.InvalidDllFunctionName
                '
                'Must fall after EntryPointNotFoundException because of inheritance
                '
            ElseIf typ Is GetType(System.TypeLoadException) Then
                Return vbErrors.CantCreateObject
            ElseIf typ Is GetType(System.OutOfMemoryException) Then
                Return vbErrors.OutOfMemory
            ElseIf typ Is GetType(System.FormatException) Then
                Return vbErrors.TypeMismatch
            ElseIf typ Is GetType(System.IO.DirectoryNotFoundException) Then
                Return vbErrors.PathNotFound
            ElseIf typ Is GetType(System.IO.IOException) Then
                Return vbErrors.IOError
            ElseIf typ Is GetType(System.IO.FileNotFoundException) Then
                Return vbErrors.FileNotFound
            ElseIf TypeOf e Is MissingMemberException Then
                Return vbErrors.OLENoPropOrMethod
            ElseIf TypeOf e Is Runtime.InteropServices.InvalidOleVariantTypeException Then
                Return vbErrors.InvalidTypeLibVariable
            Else
                Return vbErrors.IllegalFuncCall   'Generic error
            End If

        End Function

        Private Function MapNumberToException(ByVal Number As Integer,
                                              ByVal Description As String) As System.Exception
            Return ExceptionUtils.BuildException(Number, Description, False)
        End Function

        Friend Function MapErrorNumber(ByVal Number As Integer) As Integer
            If Number > 65535 Then
                ' Number cannot be greater than 65535.
                Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1), NameOf(Number))
            End If

            If Number >= 0 Then
                Return Number
            End If

            'strip off top two bytes if FACILITY_CONTROL is set
            If (Number And SCODE_FACILITY) = FACILITY_CONTROL Then
                Return (Number And &HFFFFI)
            End If

            Return Number
        End Function

    End Class
End Namespace