Imports System.Configuration
Imports System.Xml.XPath
Imports System.Xml.Serialization
Imports System.Xml
Imports System.Text
Imports System.Text.RegularExpressions
Namespace Config
Public Class XmlSerializerSectionHandler
Implements IConfigurationSectionHandler
Public Function Create(ByVal parent As Object, _
ByVal configContext As Object, _
ByVal section As System.Xml.XmlNode) As Object _
Implements IConfigurationSectionHandler.Create
'-- get the name of the type from the type= attribute on the root node
Dim xpn As XPathNavigator = section.CreateNavigator
Dim TypeName As String = xpn.Evaluate("string(@type)").ToString If TypeName = "" Then
Throw New ConfigurationException("The type attribute is not present on the root node of " & _ "the <" & section.Name & "> configuration section ", section)
End If
'-- make sure this string evaluates to a valid type
Dim t As Type = Type.GetType(TypeName)
If t Is Nothing Then
Throw New ConfigurationException("The type attribute '" & TypeName & _ "' specified in the root node of the the <" & section.Name & "> configuration section " & _
"is not a valid type.", section)
End If
Dim xs As XmlSerializer = New XmlSerializer(t)
'-- attempt to deserialize an object of this type from the provided XML section
Dim xnr As New XmlNodeReader(section)
Try
Return xs.Deserialize(xnr)
Catch ex As Exception
Dim s As String = ex.Message
Dim innerException As Exception = ex.InnerException
Do While Not innerException Is Nothing
s &= " " & innerException.Message
innerException = innerException.InnerException
Loop
Throw New ConfigurationException( _
"Unable to deserialize an object of type '" & TypeName & "' from " & _
"the <" & section.Name & "> configuration section: " & s, _
ex, section)
End Try
End Function
Public Shared Function SerializeObjectToConfigXML(ByVal configObject As Object) As String
Dim sb As New Text.StringBuilder
Dim sw As New IO.StringWriter(sb)
Dim typeName As String = configObject.GetType.FullName
Dim asmName As String = configObject.GetType.Assembly.GetName.Name
Try
Dim xs As XmlSerializer = New XmlSerializer(configObject.GetType)
Dim xsn As New XmlSerializerNamespaces
xsn.Add("", "")
Dim xtw As New Xml.XmlTextWriter(sw)
xtw.Formatting = Xml.Formatting.Indented
xtw.WriteRaw("") xs.Serialize(xtw, configObject, xsn)
Dim s As String = sb.ToString
s = regex.Replace(s, "(<" + configObject.GetType.Name + ")(>)", "$1 type=""" + typeName + ", " + asmName + """$2")
Return s
Catch ex As Exception
Debug.WriteLine("Error, unable to serialize " + typeName) Debug.Indent()
Debug.WriteLine(ex.Message)
Dim innerex As Exception = ex.InnerException
While Not innerex Is Nothing
Debug.WriteLine(innerex.Message)
innerex = innerex.InnerException
End While
Debug.Unindent()
' HACK: Pull our assembly base file name from exception message
Dim regex As regex = New regex("File or assembly name (?<baseFileName>.*).dll") Dim match As match = regex.Match(ex.Message)
Dim baseFileName As String = match.Groups("baseFileName").Value If baseFileName = "" Then
sb.Append("If you still need additional information to diagnose this problem,").Append(vbNewLine) sb.Append("add the below to your app.config, which may let you examine the intermediate files produced by the serializer").Append(vbNewLine) sb.Append("and rerun this method").Append(vbNewLine) sb.Append("<system.diagnostics>").Append(vbNewLine) sb.Append(vbTab).Append("<switches>").Append(vbNewLine) sb.Append(vbTab).Append(vbTab).Append("<add name=""XmlSerialization.Compilation"" value=""4""/>").Append(vbNewLine) sb.Append(vbTab).Append("</switches>").Append(vbNewLine)
sb.Append("</system.diagnostics>").Append(vbNewLine) Debug.WriteLine(sb.ToString)
Exit Function
End If
Dim outputPath As String = IO.Path.Combine(IO.Path.GetTempPath(), baseFileName + ".out")
Console.WriteLine((New IO.StreamReader(outputPath)).ReadToEnd())
Console.WriteLine()
Dim csPath As String = IO.Path.Combine(IO.Path.GetTempPath(), baseFileName + ".0.cs")
Debug.WriteLine("XmlSerializer-produced source:\n" + csPath) Return "Error. See debug output"
End Try
End Function
Public Function CreateConfigSectionDecl(ByVal ConfigObject As Object) As String
Dim sb As New StringBuilder
sb.Append("<section name='") sb.Append(ConfigObject.GetType.Name)
sb.Append("' ") sb.Append("type='") sb.Append(Me.GetType.FullName)
sb.Append(", ") sb.Append(Me.GetType.Assembly.GetName.Name)
sb.Append("'/>")
Return sb.ToString
End Function
End Class
End Namespace