1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
|
'
' ProjectData.vb
'
' Authors:
' Mizrahi Rafael (rafim@mainsoft.com)
'
'
' Copyright (C) 2002-2006 Mainsoft Corporation.
' Copyright (C) 2004-2006 Novell, Inc (http://www.novell.com)
'
' Permission is hereby granted, free of charge, to any person obtaining
' a copy of this software and associated documentation files (the
' "Software"), to deal in the Software without restriction, including
' without limitation the rights to use, copy, modify, merge, publish,
' distribute, sublicense, and/or sell copies of the Software, and to
' permit persons to whom the Software is furnished to do so, subject to
' the following conditions:
'
' The above copyright notice and this permission notice shall be
' included in all copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
' LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
' WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'
Imports System
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Namespace Microsoft.VisualBasic.CompilerServices
' ProjectData class is used in VB exception handling.
' it holds an ErrObject which stores the current error status of the whole running program.
<System.ComponentModel.EditorBrowsable(ComponentModel.EditorBrowsableState.Never)> _
Public NotInheritable Class ProjectData
' ProjectData singelton
Private Shared Inst As ProjectData = Nothing
#If TARGET_JVM Then
private Shared m_projectErrorSlot as LocalDataStoreSlot = System.Threading.Thread.AllocateDataSlot()
#Else
'
' ThreadStatic Indicates that the value of a static field is unique for each thread.
' Although there is one ProjectData, every thread which set get VB errors must have its own ErrObject
<ThreadStatic()> _
Friend Shared m_projectError As ErrObject
#End If
Friend ReadOnly Property ProjectError() As ErrObject
Get
#If TARGET_JVM Then
dim errObj as Object = System.Threading.Thread.GetData(m_projectErrorSlot)
if (errObj is Nothing)
errObj = New ErrObject
System.Threading.Thread.SetData(m_projectErrorSlot, errObj)
End if
return CType( errObj, ErrObject)
#Else
Return m_projectError
#End If
End Get
End Property
Private Sub New()
'Nobody should see constructor
'#If TRACE Then
' Console.WriteLine("TRACE:ProjectData.New:called")
'#End If
End Sub
'singelton, override New in order to use only one instance of ProjectData
Friend Shared Function Instance() As ProjectData
If Inst Is Nothing Then
Inst = New ProjectData
End If
#If Not TARGET_JVM Then
If m_projectError Is Nothing Then
m_projectError = New ErrObject
End If
#End If
Return Inst
End Function
'ClearProjectError is called by the statement "On Error Resume Next"
#If NET_VER >= 2.0 Then
<System.Runtime.ConstrainedExecution.ReliabilityContract(Runtime.ConstrainedExecution.Consistency.WillNotCorruptState, Runtime.ConstrainedExecution.Cer.Success)> _
Public Shared Sub ClearProjectError()
#Else
Public Shared Sub ClearProjectError()
#End If
'FIXME: "On Error Resume Next" cause to stop throwing exceptions.
'might be some friend variable of ErrObject which store that flag .
Dim pd As ProjectData = Instance()
pd.ProjectError.Clear()
End Sub
Public Shared Function CreateProjectError(ByVal hr As Integer) As Exception
'FIXME: hr might be a Windows HResult number, and not a VB error number.
'FIXME: Add a test and verify that.
#If TRACE Then
Console.WriteLine("TRACE:ProjectData.CreateProjectError:hr:" + hr.ToString())
#End If
Dim pd As ProjectData = Instance()
Dim description As String
description = Conversion.ErrorToString(hr)
pd.ProjectError.SetExceptionFromNumber(hr, description)
Return pd.ProjectError.GetException
End Function
#If NET_VER >= 2.0 Then
<System.Runtime.ConstrainedExecution.ReliabilityContract(Runtime.ConstrainedExecution.Consistency.WillNotCorruptState, Runtime.ConstrainedExecution.Cer.Success)> _
Public Overloads Shared Sub SetProjectError(ByVal ex As Exception)
#Else
Public Overloads Shared Sub SetProjectError(ByVal ex As Exception)
#End If
Dim pd As ProjectData = Instance()
pd.ProjectError.SetException(ex)
End Sub
#If NET_VER >= 2.0 Then
<System.Runtime.ConstrainedExecution.ReliabilityContract(Runtime.ConstrainedExecution.Consistency.WillNotCorruptState, Runtime.ConstrainedExecution.Cer.Success)> _
Public Overloads Shared Sub SetProjectError(ByVal ex As Exception, ByVal lErl As Integer)
#Else
Public Overloads Shared Sub SetProjectError(ByVal ex As Exception, ByVal lErl As Integer)
#End If
Throw New NotImplementedException("implement me: Erl")
'FIXME: projectError.SetException(ex)
'FIXME: projectError.Erl = lErl
'FIXME: projectError.Erl is readonly. suggested solution, add an overload of SetException(Exception,Integer)
End Sub
#If Moonlight = False Then
Public Shared Sub EndApp()
Environment.Exit(Environment.ExitCode)
End Sub
#End If
End Class
End Namespace
|