Imports System

Imports System.Linq

Imports System.Collections

Imports System.Collections.Generic

Imports System.Data

Imports System.IO

Imports System.Globalization

Imports System.Reflection

Imports System.ComponentModel.DataAnnotations

​

Imports Newtonsoft.Json

Imports Newtonsoft.Json.Linq

Imports Newtonsoft.Json.Converters

Imports Newtonsoft.Json.Serialization

​

Imports NUnit.Framework

​

    ' https://stackoverflow.com/questions/53193503/pass-additional-data-to-jsonconverter

​

    ' Generics and interfaces

​

    Public Interface ISerializationContext

        Function TryGetNameTable(Of T)(ByRef table as INameTable(Of T)) as Boolean

    End Interface

​

    Public Interface INameTable(Of T)

        Function TryGetName(value As T, ByRef name as String) As Boolean    

        Function TryGetValue(name as String, ByRef value as T) As Boolean

    End Interface

    Public Class NameTable(Of T) :  Implements INameTable(Of T)

        Public Property Dictionary as Dictionary(Of String, T) = New Dictionary(Of String, T)()

​

        Public Property ReverseDictionary as Dictionary(Of T, String) = New Dictionary(Of T, String)()

​

        Public Function Add(value as T, name as String) as T

            Dictionary.Add(name, value)

            ReverseDictionary.Add(value, name)              

            Return value

        End Function

​

        Public Function TryGetName(value As T, ByRef name as String) As Boolean Implements INameTable(Of T).TryGetName

            Return ReverseDictionary.TryGetValue(value, name)

        End Function

​

        Function TryGetValue(name as String, ByRef value as T) As Boolean Implements INameTable(Of T).TryGetValue

            Return Dictionary.TryGetValue(name, value)

        End Function

    End Class

​

    Public Class ObjectToNameConverter(Of T)

        Inherits JsonConverter

​

        Public Overrides Function CanConvert(objectType As Type) As Boolean

            Return GetType(T) = objectType

        End Function

​

        Public Overrides Sub WriteJson(writer As JsonWriter, value As Object, serializer As JsonSerializer)

            Dim tValue = CType(value, T)

            Dim context as ISerializationContext = CType(serializer.Context.Context, ISerializationContext)

            If context Is Nothing

                Throw New JsonSerializationException("No ISerializationContext.")

            End If

​

            Dim nameTable as INameTable(Of T) = Nothing

            If (Not context.TryGetNameTable(Of T)(nameTable))

                Throw New JsonSerializationException("No NameTable.")

            End If

​

            Dim name as String = Nothing

            if (Not nameTable.TryGetName(tValue, name))

                Throw New JsonSerializationException("No Name.")

            End If

​

            writer.WriteValue(name)

        End Sub

​

        Public Overrides Function ReadJson(reader As JsonReader, objectType As Type, existingValue As Object, serializer As JsonSerializer) As Object

            Dim context as ISerializationContext = CType(serializer.Context.Context, ISerializationContext)

            If context Is Nothing

                Throw New JsonSerializationException("No ISerializationContext.")

            End If

​

            Dim nameTable as INameTable(Of T) = Nothing

            If (Not context.TryGetNameTable(Of T)(nameTable))

                Throw New JsonSerializationException("No NameTable.")

            End If

​

            Dim name As String = serializer.Deserialize(Of String)(reader)

            If name Is Nothing Then

                Return Nothing

            End If

​

            dim tValue as T = Nothing

            nameTable.TryGetValue(name, tValue)

            return tValue

        End Function

    End Class

​

    ' Concrete implementations

​

    Public Class RootObject

        <JsonConverter(GetType(ObjectToNameConverter(Of SomePropertyClass)))> _

        Public Property SomeProperty As SomePropertyClass   

    End Class

​

    Public Class SomePropertyClass

    End Class

​

    Public Class MySerializationContext : Implements ISerializationContext

​

        Public Function Add(value as SomePropertyClass, name as String) as SomePropertyClass

            Return SomePropertyNameTable.Add(value, name)

        End Function

​

        Property SomePropertyNameTable as NameTable(Of SomePropertyClass) = New NameTable(Of SomePropertyClass)

​

        Public Function TryGetNameTable(Of T)(ByRef table as INameTable(Of T)) as Boolean Implements ISerializationContext.TryGetNameTable

            if (GetType(T) Is GetType(SomePropertyClass))

                table = SomePropertyNameTable

                return True

            End If

​

            table = Nothing

            return False

        End Function

    End Class   

    ' Test Code

    Public Module TestClass 

        Friend Sub Test()

            Dim context as MySerializationContext = New MySerializationContext()

            Dim someProperty as SomePropertyClass = context.Add(New SomePropertyClass(), "My Name")

            Dim root as RootObject = New RootObject With { .SomeProperty = someProperty }

            Dim settings = new JsonSerializerSettings With _

            { _

                .Context = New System.Runtime.Serialization.StreamingContext(System.Runtime.Serialization.StreamingContextStates.All, context)

            }

            Dim json as String = JsonConvert.SerializeObject(root, settings)

            Console.WriteLine(json) ' Prints {"SomeProperty":"My Name"}

            dim root2 as RootObject = JsonConvert.DeserializeObject(Of RootObject)(json, settings)

            ' Assert that the same instance of SomeProperty was used during deserialization

            Assert.IsTrue(root2.SomeProperty Is root.SomeProperty) 

            Assert.IsTrue(json.Equals("{""SomeProperty"":""My Name""}"))

        End Sub     

    End Module

​

    Public Module Module1   

        Public Sub Main()

            Console.WriteLine("Environment version: " & Environment.Version.ToString())

            Console.WriteLine("Json.NET version: " & GetType(JsonSerializer).Assembly.FullName)

            Console.WriteLine("")

​

            Try

​

                TestClass.Test()

​

            Catch ex as Exception

​

                Console.WriteLine("Unhandled exception: ")

                Console.WriteLine(ex)

                Throw

​

            End Try

        End Sub 

    End Module

​