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
|
---|