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 ClassExample:
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
- Author: Patrick Lehmann
- Submitted on: 10/28/2009 10:28:11 PM
- Language: VB
- Type: System.Object
- Views: 1863
Double click on the code to select all.