Namespace ActiveBasic Namespace Core ' 中間的な実装(継承専用) Class TypeBaseImpl Inherits System.TypeInfo strNamespace As String name As String fullName As String ' メンバ情報 memberNames As *String ' 名前リスト memberTypeFullNames As *String ' 型名リスト memberCounts As Long ' 個数 memberInfosCache As System.Collections.Generic.List Protected baseType As System.TypeInfo 'interfaces As f(^^;;; Sub TypeBaseImpl( strNamespace As String, name As String, fullName As String ) This.strNamespace = strNamespace This.name = name This.fullName = fullName This.baseType = Nothing End Sub Sub ~TypeBaseImpl() End Sub Public Sub SetMembers( memberNames As *String, memberTypeFullNames As *String, num As Long ) This.memberNames = memberNames This.memberTypeFullNames = memberTypeFullNames This.memberCounts = num /* OutputDebugString( Ex"\r\n" ) Dim i As Long For i=0 To ELM(num) OutputDebugString( memberNames[i] ) OutputDebugString( ", " ) OutputDebugString( memberTypeFullNames[i] ) OutputDebugString( Ex"\r\n" ) Next */ End Sub '---------------------------------------------------------------- ' Public properties '---------------------------------------------------------------- Override Function BaseType() As System.TypeInfo Return baseType End Function Sub SetBaseType( baseType As System.TypeInfo ) This.baseType = baseType End Sub Override Function FullName() As String Return fullName End Function Override Function IsArray() As Boolean Return False End Function Override Function IsByRef() As Boolean Return False End Function Override Function IsClass() As Boolean Return False End Function Override Function IsEnum() As Boolean Return False End Function Override Function IsInterface() As Boolean Return False End Function Override Function IsPointer() As Boolean Return False End Function Override Function IsValueType() As Boolean Return False End Function Override Function Name() As String Return name End Function Override Function Namespace() As String Return strNamespace End Function '---------------------------------------------------------------- ' Public methods '---------------------------------------------------------------- Override Function GetMembers() As System.Collections.Generic.List If Object.ReferenceEquals( memberInfosCache, Nothing ) Then ' キャッシュにないときは生成する memberInfosCache = New System.Collections.Generic.List Dim i As Long For i=0 To ELM(memberCounts) memberInfosCache.Add( New System.Reflection.MemberInfo( memberNames[i], _System_TypeBase_Search( memberTypeFullNames[i] ) ) ) Next End If Return memberInfosCache End Function End Class ' 値型を管理するためのクラス Class _System_TypeForValueType Inherits TypeBaseImpl Public Sub _System_TypeForValueType( name As String ) TypeBaseImpl( "", name, name ) End Sub Override Function IsValueType() As Boolean Return True End Function End Class ' クラスを管理するためのクラス Class _System_TypeForClass Inherits TypeBaseImpl Public referenceOffsets As *Long numOfReference As Long Sub _System_TypeForClass( strNamespace As String, name As String, fullName As String, referenceOffsets As *Long, numOfReference As Long ) TypeBaseImpl( strNamespace, name, fullName ) This.referenceOffsets = referenceOffsets This.numOfReference = numOfReference End Sub Sub _System_TypeForClass( strNamespace As String, name As String, fullName As String ) TypeBaseImpl( strNamespace, name, fullName ) End Sub Sub ~_System_TypeForClass() End Sub Override Function IsClass() As Boolean Return True End Function End Class ' インターフェイスを管理するためのクラス Class _System_TypeForInterface Inherits TypeBaseImpl Public End Class ' 列挙体を管理するためのクラス Class _System_TypeForEnum Inherits TypeBaseImpl Public End Class ' デリゲートを管理するためのクラス Class _System_TypeForDelegate Inherits TypeBaseImpl Public End Class '-------------------------------------------------------------------- ' プロセスに存在するすべての型を管理する '-------------------------------------------------------------------- Class _System_TypeBase Static types As System.Collections.Generic.Dictionary Static isReady = False Static Sub Add( typeInfo As TypeBaseImpl ) types.Add( typeInfo.FullName, typeInfo ) End Sub Static Sub InitializeValueType() types = New System.Collections.Generic.Dictionary(8191) ' 値型の追加 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Byte", fullName = "Byte" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "SByte", fullName = "SByte" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Word", fullName = "Word" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Integer", fullName = "Integer" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "DWord", fullName = "DWord" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Long", fullName = "Long" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "QWord", fullName = "QWord" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Int64", fullName = "Int64" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Boolean", fullName = "Boolean" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Single", fullName = "Single" ] ) Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Double", fullName = "Double" ] ) End Sub Static Sub InitializeUserTypes() ' このメソッドの実装はコンパイラが自動生成する '例: 'Add( New _System_TypeForClass( "System", "String", "System.String", [__offsets...], __numOfOffsets ) ) '... End Sub Static Sub InitializeUserTypesForBaseType() ' このメソッドの実装はコンパイラが自動生成する '例: 'Search( "System.String" ).SetBaseType( Search( "System.Object" ) ) '... End Sub Public Static Sub Initialize() ' 値型を初期化 InitializeValueType() ' Class / Interface / Enum / Delegate を初期化 InitializeUserTypes() isReady = True ' 基底クラスを登録 InitializeUserTypesForBaseType() selfTypeInfo = _System_TypeBase.Search( "System.TypeInfo" ) As System.TypeInfo _System_DebugOnly_OutputDebugString( Ex"ready dynamic meta datas!\r\n" ) End Sub Static Sub _NextPointerForGC() ' TODO: 実装 End Sub Static Function Search( fullName As String ) As TypeBaseImpl If Object.ReferenceEquals(types, Nothing) Then Return Nothing End If If isReady = False Then Return Nothing End If Search = types.Item(fullName) If Object.ReferenceEquals( Search, Nothing ) Then OutputDebugString("TypeSearch Failed: ") If Not ActiveBasic.IsNothing(fullName) Then OutputDebugStringW(StrPtr(fullName) As PWSTR) OutputDebugString(Ex"\r\n") OutputDebugStringA(StrPtr(fullName) As PSTR) End If OutputDebugString(Ex"\r\n") End If End Function Static Function IsReady() As Boolean Return isReady End Function Static selfTypeInfo As System.TypeInfo End Class End Namespace End Namespace Function _System_TypeBase_Search( fullName As String ) As ActiveBasic.Core.TypeBaseImpl Return ActiveBasic.Core._System_TypeBase.Search( fullName ) End Function