| 1 | Namespace System
|
|---|
| 2 | Namespace Xml
|
|---|
| 3 | Namespace Serialization
|
|---|
| 4 |
|
|---|
| 5 |
|
|---|
| 6 | Class XmlSerializer
|
|---|
| 7 | m_typeInfo As System.TypeInfo
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 | '----------------------------------------------------------------
|
|---|
| 11 | ' シリアライズ ロジック
|
|---|
| 12 | '----------------------------------------------------------------
|
|---|
| 13 |
|
|---|
| 14 | Static Sub SerializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, o As Object, doc As XmlDocument, parentNode As XmlNode )
|
|---|
| 15 | Dim valueStr = Nothing As String
|
|---|
| 16 | If typeInfo.FullName = "Byte" Then
|
|---|
| 17 | valueStr = Str$( GetByte( ObjPtr( o ) + memoryOffset ) As Byte )
|
|---|
| 18 | ElseIf typeInfo.FullName = "SByte" Then
|
|---|
| 19 | valueStr = Str$( GetByte( ObjPtr( o ) + memoryOffset ) As SByte )
|
|---|
| 20 | ElseIf typeInfo.FullName = "Word" Then
|
|---|
| 21 | valueStr = Str$( GetWord( ObjPtr( o ) + memoryOffset ) As Word )
|
|---|
| 22 | ElseIf typeInfo.FullName = "Integer" Then
|
|---|
| 23 | valueStr = Str$( GetWord( ObjPtr( o ) + memoryOffset ) As Integer )
|
|---|
| 24 | ElseIf typeInfo.FullName = "DWord" Then
|
|---|
| 25 | valueStr = Str$( GetDWord( ObjPtr( o ) + memoryOffset ) As DWord )
|
|---|
| 26 | ElseIf typeInfo.FullName = "Long" Then
|
|---|
| 27 | valueStr = Str$( GetDWord( ObjPtr( o ) + memoryOffset ) As Long )
|
|---|
| 28 | ElseIf typeInfo.FullName = "QWord" Then
|
|---|
| 29 | valueStr = Str$( GetQWord( ObjPtr( o ) + memoryOffset ) As QWord )
|
|---|
| 30 | ElseIf typeInfo.FullName = "Int64" Then
|
|---|
| 31 | valueStr = Str$( GetQWord( ObjPtr( o ) + memoryOffset ) As Int64 )
|
|---|
| 32 | ElseIf typeInfo.FullName = "Boolean" Then
|
|---|
| 33 | If GetByte( ObjPtr( o ) + memoryOffset ) As Boolean Then
|
|---|
| 34 | valueStr = "True"
|
|---|
| 35 | Else
|
|---|
| 36 | valueStr = "False"
|
|---|
| 37 | End If
|
|---|
| 38 | ElseIf typeInfo.FullName = "Single" Then
|
|---|
| 39 | valueStr = Str$( GetSingle( ObjPtr( o ) + memoryOffset ) As Single )
|
|---|
| 40 | ElseIf typeInfo.FullName = "Double" Then
|
|---|
| 41 | valueStr = Str$( GetDouble( ObjPtr( o ) + memoryOffset ) As Double )
|
|---|
| 42 | ElseIf typeInfo.FullName = "VoidPtr" Then
|
|---|
| 43 | valueStr = Str$( Get_LONG_PTR( ObjPtr( o ) + memoryOffset ) )
|
|---|
| 44 | Else
|
|---|
| 45 | Throw
|
|---|
| 46 | End If
|
|---|
| 47 |
|
|---|
| 48 | Dim childNode = doc.CreateElement( typeInfo.FullName )
|
|---|
| 49 | parentNode.AppendChild( childNode )
|
|---|
| 50 | childNode.AppendChild( doc.CreateTextNode( valueStr ) )
|
|---|
| 51 | End Sub
|
|---|
| 52 |
|
|---|
| 53 | Static Sub SerializeForClass( typeInfo As TypeInfo, o As Object, doc As XmlDocument, parentNode = Nothing As XmlNode )
|
|---|
| 54 | If typeInfo.IsClass() and typeInfo.FullName = "System.Object" Then
|
|---|
| 55 | ' Object型はシリアライズしない
|
|---|
| 56 | Return
|
|---|
| 57 | End If
|
|---|
| 58 |
|
|---|
| 59 | If ActiveBasic.IsNothing( parentNode ) Then
|
|---|
| 60 | parentNode = doc
|
|---|
| 61 | End If
|
|---|
| 62 |
|
|---|
| 63 | Dim memberInfos = typeInfo.GetMembers()
|
|---|
| 64 |
|
|---|
| 65 | ' 子ノードを生成
|
|---|
| 66 | Dim childNode = doc.CreateElement( typeInfo.Name )
|
|---|
| 67 | Dim namespaceAttr = doc.CreateAttribute( "namespace" )
|
|---|
| 68 | namespaceAttr.Value = typeInfo.Namespace
|
|---|
| 69 | childNode.Attributes.Add( namespaceAttr )
|
|---|
| 70 |
|
|---|
| 71 | ' 親ノードへ追加
|
|---|
| 72 | parentNode.AppendChild( childNode )
|
|---|
| 73 |
|
|---|
| 74 | If Not ActiveBasic.IsNothing( typeInfo.BaseType ) Then
|
|---|
| 75 | ' 基底クラスが存在するとき
|
|---|
| 76 |
|
|---|
| 77 | ' 基底クラスをシリアライズ
|
|---|
| 78 | SerializeForClass( typeInfo.BaseType, o, doc, childNode )
|
|---|
| 79 | End If
|
|---|
| 80 |
|
|---|
| 81 | ' メンバをシリアライズ
|
|---|
| 82 | Foreach memberInfo In memberInfos
|
|---|
| 83 | If memberInfo.MemberType.IsPointer() Then
|
|---|
| 84 | Throw
|
|---|
| 85 | ElseIf memberInfo.MemberType.IsClass() Then
|
|---|
| 86 | SerializeForClass( memberInfo.MemberType, o, doc, childNode )
|
|---|
| 87 | ElseIf memberInfo.MemberType.IsValueType() Then
|
|---|
| 88 | SerializeForBasicType( memberInfo.MemberType, memberInfo._System_Offset, o, doc, childNode )
|
|---|
| 89 | End If
|
|---|
| 90 | Next
|
|---|
| 91 | End Sub
|
|---|
| 92 |
|
|---|
| 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
|
|---|
| 187 | End Function
|
|---|
| 188 |
|
|---|
| 189 | Public
|
|---|
| 190 | Sub XmlSerializer( typeInfo As System.TypeInfo )
|
|---|
| 191 | This.m_typeInfo = typeInfo
|
|---|
| 192 | End Sub
|
|---|
| 193 | Sub ~XmlSerializer()
|
|---|
| 194 | End Sub
|
|---|
| 195 |
|
|---|
| 196 |
|
|---|
| 197 | /*!
|
|---|
| 198 | @brief XML文書をオブジェクトに逆シリアライズします。
|
|---|
| 199 | @author Daisuke Yamamoto
|
|---|
| 200 | */
|
|---|
| 201 | Function Deserialize( stream As System.IO.Stream ) As Object
|
|---|
| 202 | Dim doc = New XmlDocument
|
|---|
| 203 | doc.Load( stream )
|
|---|
| 204 | Return DeserializeForClass( m_typeInfo, doc.ChildNodes[1] )
|
|---|
| 205 | End Function
|
|---|
| 206 |
|
|---|
| 207 | /*!
|
|---|
| 208 | @brief オブジェクトをXML文書にシリアライズします。
|
|---|
| 209 | @author Daisuke Yamamoto
|
|---|
| 210 | */
|
|---|
| 211 | Sub Serialize( stream As System.IO.Stream, o As Object )
|
|---|
| 212 | Dim doc = New XmlDocument
|
|---|
| 213 | doc.AppendChild( doc.CreateXmlDeclaration( "1.0", "shift-jis", Nothing ) )
|
|---|
| 214 |
|
|---|
| 215 | SerializeForClass( m_typeInfo, o, doc )
|
|---|
| 216 |
|
|---|
| 217 | ' ストリームに保存
|
|---|
| 218 | doc.Save( stream )
|
|---|
| 219 | End Sub
|
|---|
| 220 | End Class
|
|---|
| 221 |
|
|---|
| 222 |
|
|---|
| 223 | End Namespace
|
|---|
| 224 | End Namespace
|
|---|
| 225 | End Namespace
|
|---|
