| File: Microsoft\VisualBasic\CompilerServices\ProjectData.vb | Web Access |
| Project: src\runtime\src\libraries\Microsoft.VisualBasic.Core\src\Microsoft.VisualBasic.Core.vbproj (Microsoft.VisualBasic.Core) |
' Licensed to the .NET Foundation under one or more agreements. ' The .NET Foundation licenses this file to you under the MIT license. Imports System Namespace Global.Microsoft.VisualBasic.CompilerServices <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never)> Friend NotInheritable Class AssemblyData Friend Sub New() Dim i As Integer Dim o As Object Dim files As Collections.ArrayList = New Collections.ArrayList(256) o = Nothing For i = 0 To 255 files.Add(o) Next m_Files = files End Sub Friend Function GetChannelObj(ByVal lChannel As Integer) As VB6File Dim o As Object If (lChannel < m_Files.Count) Then o = m_Files.Item(lChannel) Else o = Nothing End If Return CType(o, VB6File) End Function Friend Sub SetChannelObj(ByVal lChannel As Integer, ByVal oFile As VB6File) If m_Files Is Nothing Then m_Files = New Collections.ArrayList(256) End If Dim o As Object If oFile Is Nothing Then Dim f As VB6File f = CType(m_Files.Item(lChannel), VB6File) If (Not f Is Nothing) Then f.CloseFile() End If m_Files.Item(lChannel) = Nothing Else o = oFile m_Files.Item(lChannel) = o End If End Sub Public m_Files As Collections.ArrayList Friend m_DirFiles() As IO.FileSystemInfo Friend m_DirNextFileIndex As Integer Friend m_DirAttributes As IO.FileAttributes End Class <Global.System.Diagnostics.DebuggerNonUserCode()> <Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never)> Public NotInheritable Class ProjectData Friend m_Err As ErrObject Friend m_rndSeed As Integer = &H50000I Friend m_numprsPtr() As Byte Friend m_DigitArray() As Byte 'm_oProject is per-Thread <System.ThreadStaticAttribute()> Private Shared m_oProject As ProjectData Friend m_AssemblyData As Collections.Hashtable Private Sub New() MyBase.New() m_AssemblyData = New System.Collections.Hashtable Const DIGIT_ARRAY_SIZE As Integer = 30 Const NUMPRS_SIZE As Integer = 24 ReDim m_numprsPtr(NUMPRS_SIZE - 1) ReDim m_DigitArray(DIGIT_ARRAY_SIZE - 1) End Sub Private m_CachedMSCoreLibAssembly As System.Reflection.Assembly = GetType(System.Int32).Assembly Friend Function GetAssemblyData(ByVal assem As System.Reflection.Assembly) As AssemblyData 'The first time, we will get an exception, but the remainder of the time there will be less overhead ' If assem Is Utils.VBRuntimeAssembly OrElse assem Is m_CachedMSCoreLibAssembly Then 'Must have been from a latebound call to our own apis (potentially through context of mscorlib) 'This must not be allowed, as it would cause files to be shared across assemblies Throw New Security.SecurityException(SR.Security_LateBoundCallsNotPermitted) End If Dim AssemData As AssemblyData = CType(m_AssemblyData.Item(assem), AssemblyData) If (AssemData Is Nothing) Then AssemData = New AssemblyData m_AssemblyData.Item(assem) = AssemData End If Return AssemData End Function Friend Shared Function GetProjectData() As ProjectData '************************* '*** PERFORMANCE NOTE: *** '************************* ' m_oProject is <ThreadStatic> ' and is pretty expensive to access so we cache to a local ' to cut the number of accesses in half GetProjectData = m_oProject If GetProjectData Is Nothing Then GetProjectData = New ProjectData m_oProject = GetProjectData End If End Function ''' <summary> ''' This function is called by the compiler in response to err code, e.g. err 123 ''' It is also called when the compiler encounters a resume that isn't preceded by an On Error command ''' </summary> ''' <param name="hr"></param> ''' <returns></returns> Public Shared Function CreateProjectError(ByVal hr As Integer) As System.Exception '************************* '*** PERFORMANCE NOTE: *** '************************* ' Err Object is <ThreadStatic> and is pretty expensive to access so we cache to a local to cut the number of accesses Dim ErrObj As ErrObject = Err() ErrObj.Clear() Dim ErrNumber As Integer = ErrObj.MapErrorNumber(hr) Return ErrObj.CreateException(hr, Utils.GetResourceString(CType(ErrNumber, vbErrors))) End Function ''' <summary> ''' Called by the compiler in response to falling into a catch block. ''' Inside the catch statement the compiler generates code to call: ''' ProjectData::SetProjectError(exception) That call ''' in turns sets the ErrObject which is accessed via the VB Err statement. ''' So a VB6 programmer would typically then do something like: ''' if err.Number = * do something where err accesses the ErrObject that ''' is set by this method. ''' </summary> ''' <param name="ex"></param> Public Overloads Shared Sub SetProjectError(ByVal ex As Exception) Err.CaptureException(ex) End Sub ''' <summary> ''' Called by the compiler in response to falling into a catch block. ''' Inside the catch statement the compiler generates code to call: ''' ProjectData::SetProjectError(exception, lineNumber) This call ''' differs from SetProjectError(ex as Exception)because it is called ''' when the exception is thrown from a specific line number, e.g: ''' 123: Throw new Exception ''' 123: Error x80004003 ''' This method in turn sets the ErrObject which is accessed via the ''' VB "Err" statement. ''' So a VB6 programmer could then do something like: ''' if err.Number = * ''' err.Erl will also be set ''' is set by this class. ''' </summary> ''' <param name="ex"></param> ''' <param name="lErl"></param> Public Overloads Shared Sub SetProjectError(ByVal ex As Exception, ByVal lErl As Integer) Err.CaptureException(ex, lErl) End Sub Public Shared Sub ClearProjectError() Err.Clear() End Sub Public Shared Sub EndApp() FileSystem.CloseAllFiles(System.Reflection.Assembly.GetCallingAssembly()) System.Environment.Exit(0) 'System.Environment.Exit will cause finalizers to be run at shutdown End Sub End Class End Namespace