public
Created

  • Download Gist
gistfile1.bas
Visual Basic
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
Imports System
Imports System.Web
Imports System.Web.Mvc
Imports System.IO
Imports System.Xml
Imports System.Text
Imports System.Collections.Generic
Imports System.Web.Script.Serialization
Imports System.Runtime.Serialization
Imports System.Reflection
Imports System.Reflection.Emit
 
Public Class restResult
Inherits ActionFilterAttribute
 
Private _actionParams As [String]()
 
''// for deserialization
Public Sub New(ByVal ParamArray parameters As [String]())
Me._actionParams = parameters
End Sub
 
 
''// SERIALIZE
Public Overrides Sub OnActionExecuted(ByVal filterContext As ActionExecutedContext)
If Not (TypeOf filterContext.Result Is ViewResult) Then
Exit Sub
End If
 
' // SETUP
Dim utf8 As New UTF8Encoding(False)
Dim request As HttpRequestBase = filterContext.RequestContext.HttpContext.Request
Dim contentType As [String] = If(request.ContentType, String.Empty)
Dim view As ViewResult = DirectCast(filterContext.Result, ViewResult)
Dim data = view.ViewData.Model
 
 
' JSON
If contentType.Contains("application/json") OrElse request.IsAjaxRequest() Then
Using stream = New MemoryStream()
Dim js As New JavaScriptSerializer()
'Här kan det bli fel, tog bort key . c....
Dim content As [String] = js.Serialize(data)
filterContext.Result = New ContentResult() With { _
.ContentType = "application/json", _
.Content = content, _
.ContentEncoding = utf8 _
}
 
End Using
ElseIf contentType.Contains("text/xml") Then
' MemoryStream to encapsulate as UTF-8 (default UTF-16)
' http://stackoverflow.com/questions/427725/
'
' MemoryStream also used for atomicity but not here
' http://stackoverflow.com/questions/486843/
Using stream As New MemoryStream(500)
Using xmlWriter = XmlTextWriter.Create(stream, New XmlWriterSettings() With { _
.OmitXmlDeclaration = True, _
.Encoding = utf8, _
.Indent = True _
})
 
' knownTypes
' maxItemsInObjectGraph
' ignoreExtensionDataObject
' preserveObjectReference - overcomes cyclical reference issues
' dataContractSurrogate
' Dim x As New datacontractserializer
' Dim x As datacontractSerializer = New datacontractserializer(
' Dim ser As New DataContractSerializer(GetType(Person))
Dim ser As New DataContractSerializer(data.[GetType](), Nothing, 65536, False, True, Nothing)
ser.WriteObject(stream, data)
End Using
 
filterContext.Result = New ContentResult() With { _
.ContentType = "text/xml", _
.Content = utf8.GetString(stream.ToArray()), _
.ContentEncoding = utf8 _
}
End Using
End If
End Sub
 
' DESERIALIZE
Public Overrides Sub OnActionExecuting(ByVal filterContext As ActionExecutingContext)
 
If _actionParams Is Nothing OrElse _actionParams.Length = 0 Then
Exit Sub
End If
 
Dim request As HttpRequestBase = filterContext.RequestContext.HttpContext.Request
Dim contentType As [String] = If(request.ContentType, String.Empty)
Dim isJson As [Boolean] = contentType.Contains("application/json")
 
 
If Not isJson Then
Exit Sub
End If
'@@todo Deserialize POX
 
' JavascriptSerialier expects a single type to deserialize
' so if the response contains multiple disparate objects to deserialize
' we dynamically build a new wrapper class with fields representing those
' object types, deserialize and then unwrap
 
Dim paramDescriptors As ParameterDescriptor() = filterContext.ActionDescriptor.GetParameters()
Dim complexType As [Boolean] = paramDescriptors.Length > 1
 
Dim wrapperClass As Type
If complexType Then
Dim parameterInfo As New Dictionary(Of String, Type)
For Each p As ParameterDescriptor In paramDescriptors
parameterInfo.Add(p.ParameterName, p.ParameterType)
Next
wrapperClass = BuildWrapperClass(parameterInfo)
Else
wrapperClass = paramDescriptors(0).ParameterType
End If
 
Dim json As [String]
Using sr = New StreamReader(request.InputStream)
json = sr.ReadToEnd()
End Using
 
' then deserialize json as instance of dynamically created wrapper class
Dim serializer As New JavaScriptSerializer()
Dim result = GetType(JavaScriptSerializer).GetMethod("Deserialize").MakeGenericMethod(wrapperClass).Invoke(serializer, New Object() {json})
 
' then get fields from wrapper class assign the values back to the action params
If complexType Then
For i As Int32 = 0 To paramDescriptors.Length - 1
Dim pd As ParameterDescriptor = paramDescriptors(i)
 
filterContext.ActionParameters(pd.ParameterName) = wrapperClass.GetField(pd.ParameterName).GetValue(result)
Next
Else
Dim pd As ParameterDescriptor = paramDescriptors(0)
filterContext.ActionParameters(pd.ParameterName) = result
End If
 
End Sub
Private Function BuildWrapperClass(ByVal parameterInfo As Dictionary(Of String, Type)) As Type
Dim assemblyName As New AssemblyName()
assemblyName.Name = "DynamicAssembly"
Dim appDomain__1 As AppDomain = AppDomain.CurrentDomain
Dim assemblyBuilder As AssemblyBuilder = appDomain__1.DefineDynamicAssembly(assemblyName, AssemblyBuilderAccess.Run)
Dim moduleBuilder As ModuleBuilder = assemblyBuilder.DefineDynamicModule("DynamicModule")
Dim typeBuilder As TypeBuilder = moduleBuilder.DefineType("DynamicClass", TypeAttributes.[Public] Or TypeAttributes.[Class])
 
For Each entry As KeyValuePair(Of String, Type) In parameterInfo
Dim paramName As [String] = entry.Key
Dim paramType As Type = entry.Value
Dim field As FieldBuilder = typeBuilder.DefineField(paramName, paramType, FieldAttributes.[Public])
Next
 
Dim generatedType As Type = typeBuilder.CreateType()
' object generatedObject = Activator.CreateInstance(generatedType);
 
Return generatedType
End Function
 
End Class

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.