ToXMLRPCStruct

Option Infer On

Imports System.Runtime.CompilerServices
Imports System.Reflection

Module Extensions
    <Extension()> _
   Function ToXMLRPCStruct(ByVal Obj As Object) As Object
#If CONFIG = "Debug" Then
        Try
            Dim ObjAttList() As XMLRPCProxyStructureAttribute = Obj.GetType.GetCustomAttributes(GetType(XMLRPCProxyStructureAttribute), True)

            If ObjAttList.Length <> 1 Then Throw New MissingAttributeException("Before using ToXMLRPCStructure,  XMLRPCProxyStructureAttribute must be set")

            Dim StructType As Type = ObjAttList(0).StructureType
            Dim C() As ConstructorInfo = StructType.GetConstructors()

            If C.Length <> 1 Then Throw New Exception("There must be exact one constructor for " & StructType.ToString)
            If C(0).GetParameters.Length <> 1 Then Throw New Exception("Constructor of " & StructType.ToString & " must have exactly one parameter")

            Dim Params() As Object = {Obj}
            Dim Struct As Object = Activator.CreateInstance(StructType, Params)

            Return Struct
        Catch ex As Exception
            Console.WriteLine()
            Console.WriteLine("Ext. Method ToXMLRPCStruct:")
            Console.WriteLine("  " & ex.Message)
            Console.WriteLine()
            Return Nothing
        End Try
#ElseIf CONFIG = "Release" Then
        Dim ObjAttList() As XMLRPCProxyStructureAttribute = Obj.GetType.GetCustomAttributes(GetType(XMLRPCProxyStructureAttribute), True)
        Return Activator.CreateInstance(ObjAttList(0).StructureType, new Object {Obj})
#End If
    End Function
End Module

'--------------
Option Infer On

Public Class MissingAttributeException
    Inherits Exception

    Public Sub New(ByVal Message As String)
        MyBase.New(Message)
    End Sub
End Class

'--------------
Option Infer On

<AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=True)> _
Public Class XMLRPCProxyStructureAttribute
    Inherits Attribute

    Public StructureType As Type

    Public Sub New(ByVal StructureType As Type)
        Me.StructureType = StructureType
    End Sub
End Class

<AttributeUsage(AttributeTargets.Field, AllowMultiple:=False, Inherited:=False)> _
Public MustInherit Class XMLRPCProxyStructureMemberAttribute
    Inherits Attribute

    Public ReadOnly MemberName As String
    Public ReadOnly Recursiv As Boolean

    Public Sub New(ByVal MemberName As String, Optional ByVal Recursiv As Boolean = False)
        Me.MemberName = MemberName
        Me.Recursiv = Recursiv
    End Sub
End Class

<AttributeUsage(AttributeTargets.Field, AllowMultiple:=False, Inherited:=False)> _
Public Class XMLRPCProxyStructureFieldAttribute
    Inherits XMLRPCProxyStructureMemberAttribute

    Public Sub New(ByVal MemberName As String, Optional ByVal Recursiv As Boolean = False)
        MyBase.New(MemberName, Recursiv)
    End Sub
End Class

<AttributeUsage(AttributeTargets.Field, AllowMultiple:=False, Inherited:=False)> _
Public Class XMLRPCProxyStructurePropertyAttribute
    Inherits XMLRPCProxyStructureMemberAttribute

    Public Sub New(ByVal MemberName As String, Optional ByVal Recursiv As Boolean = False)
        MyBase.New(MemberName, Recursiv)
    End Sub
End Class

<AttributeUsage(AttributeTargets.Field, AllowMultiple:=False, Inherited:=False)> _
Public Class XMLRPCProxyStructureMethodAttribute
    Inherits XMLRPCProxyStructureMemberAttribute

    Public Sub New(ByVal MemberName As String, Optional ByVal Recursiv As Boolean = False)
        MyBase.New(MemberName, Recursiv)
    End Sub
End Class
Example: 
Option Explicit On
Option Strict On
Option Infer On

<XMLRPCProxyStructureAttribute(GetType(SIdentifier))> _
Public Class Identifier

    Protected _ID As Integer

    Public Sub New(ByVal ID As Integer)
        Me._ID = ID
    End Sub

    Public ReadOnly Property ID() As Integer
        Get
            Return Me._ID
        End Get
    End Property
End Class

'--------------
Option Infer On

Public Structure SIdentifier
    <XMLRPCProxyStructureProperty("ID", True)> _
    Public ID As Integer

    Public Sub New(ByVal ID As Identifier)
        Me.ID = If(ID IsNot Nothing, ID.ID, 0)
    End Sub
End Structure

Dim PersonID As New Identifier(1)
Dim S_id As SIdentifier = PersonID.ToXMLRPCStruct()

Description

This Extension Method is built to be used with XML-RPC.NET (http://www.xml-rpc.net/) Quick converting classes to lightwight xmlrpc structures. Correspondending structures are identified with attributes

Details

Double click on the code to select all.

 

;