Ignore:
Timestamp:
Mar 13, 2008, 9:44:51 AM (17 years ago)
Author:
dai
Message:

XmlSerializer.Deserializeメソッドを実装(仮実装なため、数値メンバのシリアライズのみに留まっている)。
XmlNode.LastChildメソッドを追加。
XmlNode.NextSiblingメソッドを追加。
XmlNode.PreviouseSiblingメソッドを追加。

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/Include/Classes/System/Xml/Serialization/XmlSerializer.ab

    r452 r475  
    66Class XmlSerializer
    77    m_typeInfo As System.TypeInfo
     8
     9
     10    '----------------------------------------------------------------
     11    ' シリアライズ ロジック
     12    '----------------------------------------------------------------
    813
    914    Static Sub SerializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, o As Object, doc As XmlDocument, parentNode As XmlNode )
     
    4449        parentNode.AppendChild( childNode )
    4550        childNode.AppendChild( doc.CreateTextNode( valueStr ) )
    46 
    4751    End Sub
    4852
     
    8791    End Sub
    8892
    89     Function Deserialize( doc As XmlDocument ) As Object
     93
     94    '----------------------------------------------------------------
     95    ' デシリアライズ ロジック
     96    '----------------------------------------------------------------
     97
     98    Static Sub DeserializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, object As Object, xmlNode As XmlNode )
     99        If Not xmlNode.ChildNodes.Count = 1 Then
     100            Throw
     101        End If
     102
     103        Dim valueStr = xmlNode.ChildNodes[0].Value
     104        Dim memberPtr = ObjPtr( object ) + memoryOffset
     105
     106        If typeInfo.FullName = "Byte" Then
     107            SetByte( memberPtr, Val( valueStr ) )
     108        ElseIf typeInfo.FullName = "SByte" Then
     109            SetByte( memberPtr, Val( valueStr ) )
     110        ElseIf typeInfo.FullName = "Word" Then
     111            SetWord( memberPtr, Val( valueStr ) )
     112        ElseIf typeInfo.FullName = "Integer" Then
     113            SetWord( memberPtr, Val( valueStr ) )
     114        ElseIf typeInfo.FullName = "DWord" Then
     115            SetDWord( memberPtr, Val( valueStr ) )
     116        ElseIf typeInfo.FullName = "Long" Then
     117            SetDWord( memberPtr, Val( valueStr ) )
     118        ElseIf typeInfo.FullName = "QWord" Then
     119            SetQWord( memberPtr, Val( valueStr ) )
     120        ElseIf typeInfo.FullName = "Int64" Then
     121            SetQWord( memberPtr, Val( valueStr ) )
     122        ElseIf typeInfo.FullName = "Boolean" Then
     123            If valueStr = "True" Then
     124                SetByte( memberPtr, 1 )
     125            ElseIf valueStr = "False" Then
     126                SetByte( memberPtr, 0 )
     127            Else
     128                Throw
     129            End If
     130        ElseIf typeInfo.FullName = "Single" Then
     131            SetSingle( memberPtr, Val( valueStr ) )
     132        ElseIf typeInfo.FullName = "Double" Then
     133            SetDouble( memberPtr, Val( valueStr ) )
     134        ElseIf typeInfo.FullName = "VoidPtr" Then
     135            Set_LONG_PTR( memberPtr, Val( valueStr ) As LONG_PTR )
     136        Else
     137            Throw
     138        End If
     139    End Sub
     140
     141    Function DeserializeForClass( typeInfo As TypeInfo, xmlNode As XmlNode ) As Object
     142        If typeInfo.IsClass() and typeInfo.FullName = "System.Object" Then
     143            ' Object型にたどり着いた場合
     144
     145            ' 派生クラスのフルネームを元に特定されたクラスを生成し、デフォルトコンストラクタを呼ぶ
     146            Return ActiveBasic.Core._System_TypeForClass._System_New( m_typeInfo As ActiveBasic.Core._System_TypeForClass )
     147        End If
     148
     149        If typeInfo.Name <> xmlNode.LocalName Then
     150            Throw
     151        End If
     152
     153        Dim object = Nothing As Object
     154        Dim memberInfos = typeInfo.GetMembers()
     155
     156        If Not ActiveBasic.IsNothing( typeInfo.BaseType ) Then
     157            ' 基底クラスが存在するとき
     158
     159            ' 基底クラスをシリアライズ
     160            object = DeserializeForClass( typeInfo.BaseType, xmlNode )
     161        End If
     162
     163        ' メンバをシリアライズ
     164        Dim childNode = xmlNode.ChildNodes[0] As XmlNode
     165        Foreach memberInfo In memberInfos
     166            If ActiveBasic.IsNothing( childNode ) Then
     167                Throw
     168            End If
     169
     170            If memberInfo.MemberType.IsPointer() Then
     171                Throw
     172            ElseIf memberInfo.MemberType.IsClass() Then
     173                Dim memberObject = DeserializeForClass( memberInfo.MemberType, childNode )
     174                Set_LONG_PTR( ObjPtr( object ) + memberInfo._System_Offset, ObjPtr( memberObject ) As LONG_PTR )
     175            ElseIf memberInfo.MemberType.IsValueType() Then
     176                DeserializeForBasicType( memberInfo.MemberType, memberInfo._System_Offset, object, childNode )
     177            End If
     178
     179            childNode = childNode.NextSibling
     180        Next
     181
     182        If Not ActiveBasic.IsNothing( childNode ) Then
     183            Throw
     184        End If
     185
     186        Return object
    90187    End Function
    91188
     
    105202        Dim doc = New XmlDocument
    106203        doc.Load( stream )
    107         Deserialize( doc )
     204        Return DeserializeForClass( m_typeInfo, doc.ChildNodes[1] )
    108205    End Function
    109206
Note: See TracChangeset for help on using the changeset viewer.