Imports System.Reflection
Imports System.Xml
Imports System.Xml.Serialization
Imports System.Collections.ObjectModel
Namespace DNE.Components
Public Class CollectionBase(Of T)
Inherits Collection(Of T)
Implements IXmlSerializable
Private NodeNames As Collection(Of Node)
Private startTag As String = "<{0}>"
Private endTag As String = "</{0}>"
Public Sub New()
NodeNames = New Collection(Of Node)
End Sub
#Region " IXmlSerializable "
Public Sub ReadXml(ByVal reader As System.Xml.XmlReader) Implements System.Xml.Serialization.IXmlSerializable.ReadXml
Dim pc() As PropertyInfo = GetType(T).GetProperties()
While reader.Read()
If reader.Name = GetType(T).Name Then
reader.Read()
If pc.Length > 0 Then
Dim ti As T = GetInstance()
For i As Int32 = 0 To pc.Length - 1
If pc(i).CanRead And pc(i).CanWrite Then
Dim st As SerilalizeType = GetSerilalizeType(pc(i).PropertyType)
If st = SerilalizeType.Complex Then
Dim o As Object = GetInstance(pc(i).PropertyType)
DesrializeObject(reader, o, pc(i).Name)
pc(i).SetValue(ti, _
Convert.ChangeType(o, pc(i).PropertyType), _
Nothing)
ElseIf st = SerilalizeType.Guid Then
Dim strGuid As String = reader.ReadElementString(pc(i).Name)
Dim newId As Guid = New Guid(strGuid)
pc(i).SetValue(ti, New Guid(strGuid), Nothing)
ElseIf st = SerilalizeType.Array Then
Dim sp As New Stopwatch
sp.Start()
Dim o As Object = Nothing
DesrializeArray(reader, o, pc(i).PropertyType)
pc(i).SetValue(ti, _
Convert.ChangeType(o, pc(i).PropertyType), _
Nothing)
sp.Stop()
sp.ToString()
ElseIf st = SerilalizeType.ICollection Then
Dim sp As New Stopwatch
sp.Start()
Dim o As Object = Nothing
DesrializeCollection(reader, o, pc(i).PropertyType)
pc(i).SetValue(ti, _
Convert.ChangeType(o, pc(i).PropertyType), _
Nothing)
sp.Stop()
sp.ToString()
Else
pc(i).SetValue(ti, _
Convert.ChangeType( _
reader.ReadElementString(pc(i).Name), pc(i).PropertyType), _
Nothing)
End If
End If
Next
Me.Add(ti)
End If
End If
End While
End Sub
Public Sub WriteXml(ByVal writer As System.Xml.XmlWriter) Implements System.Xml.Serialization.IXmlSerializable.WriteXml
Dim pc() As PropertyInfo = GetType(T).GetProperties()
Dim ti As T = Nothing
For i As Int32 = 0 To Me.Items.Count - 1
ti = Me.Item(i)
writer.WriteStartElement(GetType(T).Name)
For j As Int32 = 0 To pc.Length - 1
If pc(j).CanRead And pc(j).CanWrite Then
writer.WriteStartElement(pc(j).Name)
Dim st As SerilalizeType = GetSerilalizeType(pc(j).PropertyType)
If st = SerilalizeType.Complex Or st = SerilalizeType.Array Or st = SerilalizeType.ICollection Then
writer.WriteRaw(SerializeObject(pc(j).GetValue(ti, Nothing)))
Else
writer.WriteString(pc(j).GetValue(ti, Nothing).ToString())
End If
writer.WriteEndElement()
End If
Next
writer.WriteEndElement()
Next
End Sub
Public Function GetSchema() As System.Xml.Schema.XmlSchema Implements System.Xml.Serialization.IXmlSerializable.GetSchema
Return Nothing
End Function
#End Region
#Region " Serialize Private Methods "
Private Function SerializeObject(ByVal o As Object) As String
Dim xs As New XmlSerializer(o.GetType(), "")
Dim sw As New IO.StringWriter()
xs.Serialize(sw, o)
xs = Nothing
Dim s As String = sw.ToString()
Dim xdoc As New Xml.XmlDocument()
xdoc.LoadXml(s)
Return xdoc.DocumentElement.InnerXml
End Function
#End Region
#Region " DeSerialize Private Methods "
Private Sub DesrializeObject(ByVal r As XmlReader, ByRef o As Object, ByVal PropertyName As String)
Dim xml As String = "<?xml version=""1.0""?>"
xml += r.ReadOuterXml()
xml = xml.Replace(">", ">" & vbCrLf)
xml = xml.Trim()
Dim n As Node = GetNodeName(SerilalizeType.Complex, Nothing, o)
Dim sxml() As String = xml.Split(vbCrLf)
sxml(1) = String.Format(startTag, n.Name)
sxml(sxml.Length - 1) = String.Format(endTag, n.Name)
xml = Join(sxml, vbCrLf)
Dim sr As New IO.StringReader(xml)
Dim xsr As XmlSerializer = XmlSerializer.FromTypes(New Type() {o.GetType()})(0)
o = xsr.Deserialize(sr)
End Sub
Private Sub DesrializeArray(ByVal r As XmlReader, ByRef o As Array, ByVal ArrayType As Type)
Dim cont As Boolean = True
Dim counter As Int32 = 0
Dim depth As Int32 = 0
depth = r.Depth
Dim xml As String = "<?xml version=""1.0""?>"
xml += r.ReadOuterXml()
xml = xml.Replace(">", ">" & vbCrLf)
xml = xml.Trim()
Dim n As Node = GetNodeName(SerilalizeType.Array, ArrayType)
Dim sxml() As String = xml.Split(vbCrLf)
sxml(1) = String.Format(startTag, n.Name)
sxml(sxml.Length - 1) = String.Format(endTag, n.Name)
xml = Join(sxml, vbCrLf)
Dim sr As New IO.StringReader(xml)
o = n.Serializer.Deserialize(sr)
End Sub
Private Sub DesrializeCollection(ByVal r As XmlReader, ByRef o As Object, ByVal ArrayType As Type)
Dim xml As String = "<?xml version=""1.0""?>"
xml += r.ReadOuterXml()
xml = xml.Replace(">", ">" & vbCrLf)
xml = xml.Trim()
Dim n As Node = GetNodeName(SerilalizeType.ICollection, ArrayType)
Dim sxml() As String = xml.Split(vbCrLf)
sxml(1) = String.Format(startTag, n.Name)
sxml(sxml.Length - 1) = String.Format(endTag, n.Name)
xml = Join(sxml, vbCrLf)
Dim sr As New IO.StringReader(xml)
o = n.Serializer.Deserialize(sr)
End Sub
#End Region
#Region " GetNodeName for DeSerialization "
Private Function GetNodeName(ByVal ot As SerilalizeType, ByVal objType As Type, Optional ByVal o As Object = Nothing) As Node
Dim n As Node = Nothing
Select Case ot
Case SerilalizeType.Array
n = GetNodeNameFromCache(GetArrayType(objType))
If n IsNot Nothing Then
Return n
Else
Return GetNodeNameArray(objType)
End If
Exit Select
Case SerilalizeType.Complex
Return GetNodeNameObject(o)
Exit Select
Case SerilalizeType.Guid
Case SerilalizeType.ICollection
n = GetNodeNameFromCache(objType)
If n IsNot Nothing Then
Return n
Else
Return GetNodeNameCollection(objType)
End If
Exit Select
Case SerilalizeType.Simple
End Select
Return Nothing
End Function
Private Function GetNodeNameFromCache(ByRef ot As Type) As Node
For i As Int32 = 0 To NodeNames.Count - 1
If NodeNames(i).T Is ot Then
Return NodeNames(i)
End If
Next
Return Nothing
End Function
Private Function GetNodeNameObject(ByVal o As Object) As Node
Return New Node(Nothing, o.GetType().Name, Nothing)
End Function
Private Function GetNodeNameArray(ByVal ArrayType As Type) As Node
Dim tt As Type = GetArrayType(ArrayType)
Dim nname As String = "ArrayOf" & UpperFirst(tt.Name)
Dim xsr As XmlSerializer = XmlSerializer.FromTypes(New Type() {ArrayType})(0)
Dim n As New Node(tt, nname, xsr)
NodeNames.Add(n)
Return n
End Function
Private Function GetNodeNameCollection(ByVal ArrayType As Type) As Node
Dim xsr As XmlSerializer = XmlSerializer.FromTypes(New Type() {ArrayType})(0)
Dim sw As New IO.StringWriter()
xsr.Serialize(sw, GetInstance(ArrayType))
Dim ss As String = sw.ToString()
Dim xdoc As New XmlDocument()
xdoc.LoadXml(ss)
Dim n As New Node(ArrayType, xdoc.DocumentElement.Name, xsr)
NodeNames.Add(n)
Return n
End Function
#End Region
#Region " Helper Methods "
Private Function GetProperties() As PropertyInfo()
Dim pcx() As PropertyInfo = GetType(T).GetProperties()
Dim al As New ArrayList
For i As Int32 = 0 To pcx.Length - 1
If pcx(i).CanWrite & pcx(i).CanRead Then
al.Add(pcx(i))
End If
Next
Return al.ToArray(GetType(PropertyInfo))
End Function
Private Function GetSerilalizeType(ByVal ptype As Type) As SerilalizeType
If ptype Is GetType(Guid) Then Return SerilalizeType.Guid
If ptype.IsValueType Then Return SerilalizeType.Simple
If ptype Is GetType(String) Then Return SerilalizeType.Simple
If ptype.IsArray Then Return SerilalizeType.Array
If IsCollection(ptype) Then Return SerilalizeType.ICollection
If ptype.IsSerializable Then Return SerilalizeType.Complex
Return SerilalizeType.Complex
End Function
Private Function IsCollection(ByVal ct As Type) As Boolean
Dim it As Type = GetType(ICollection)
Dim ta() As Type = ct.GetInterfaces()
If Array.IndexOf(ta, it) >= 0 Then
Return True
End If
Return False
End Function
Private Function GetArrayType(ByVal arrayType As Type) As Type
Try
Dim arrType As String = arrayType.FullName
If arrType.Contains("[") Then arrType = arrType.Substring(0, arrayType.FullName.IndexOf("["))
Return Type.GetType(arrType)
Catch ex As Exception
Return Nothing
End Try
End Function
Private Function GetInstance() As T
Return GetType(T).Assembly.CreateInstance(GetType(T).Namespace & "." & GetType(T).Name)
End Function
Private Function GetInstance(ByVal ot As Type) As Object
Return ot.Assembly.CreateInstance(ot.FullName)
End Function
Private Function UpperFirst(ByVal s As String)
Return s.Substring(0, 1).ToUpper() & s.Substring(1)
End Function
#End Region
End Class
Public Enum SerilalizeType
Simple = 0
Array = 1
ICollection = 2
Guid = 3
Complex = 4
End Enum
Public Class Node
Private _t As Type
Private _name As String
Private _sr As XmlSerializer
Public Sub New()
End Sub
Public Sub New(ByVal _Type As Type, ByVal NodeName As String, ByVal srl As XmlSerializer)
_t = _Type
_name = NodeName
_sr = srl
End Sub
Public Property T() As Type
Get
Return _t
End Get
Set(ByVal value As Type)
End Set
End Property
Public Property Name() As String
Get
Return _name
End Get
Set(ByVal value As String)
_name = value
End Set
End Property
Public Property Serializer() As XmlSerializer
Get
Return _sr
End Get
Set(ByVal value As XmlSerializer)
_sr = value
End Set
End Property
End Class
End Namespace
Submit an article or tip