完全自己编写的适用于 .Net7 简单的JSON序列化类的VB实现（.net7 aot 编译后也能序列化自定义类）

​
.net7 正式发布了，在aot编译后很多用反射来实现的功能都不好用，如JSON序列化自定义类。

JSON序列化失效特别是在VB下更甚，在C#下还可以通过以下方式实现：

  public class Test {
      public string AA { get; set; } = "A";
      public string BB { get; set; } = "B";
  }        
  [JsonSerializable(typeof(Test))]    
  public partial class TestContext : JsonSerializerContext
  {     
  }
    
 var T = new Test();
 var utf8Json = JsonSerializer.SerializeToUtf8Bytes(T, TestContext.Default.Test);
 var s = Encoding.UTF8.GetString(utf8Json);
 Console.WriteLine(s);
 //{"AA":"A","BB":"B"}

以上代码，其实相当于IDE编写了一段 隐藏补充代码，帮助实现JSON序列化，

但是这样的代码翻译到VB下就完全不生效，IDE不会编写了隐藏补充代码，Aot编译后JSON序列化完全没内容。

为了VB下aot编译后能用上JSON序列化，我创意了一个定以类，来实现VB aot 编译后的 JSON序列化，和 反序列化（反序列化为 Dictionary(Of String, Object) 和 List(of Object) 的组合体）。
这样自己的序列化类可以 不用 JSON.net 和 微软的JSON类（这两个在.net7 aot 后也不好用），节约编译后的大小。

以下是我做的序列化类的代码：

Imports System.Reflection

Public Class HappyJsonConvert
    Public Class JsonIgnore
        Inherits Attribute
    End Class
    Public Shared Function DeserializeObject(JS As String) As Object
        Dim ErrorInfo As String = Nothing
        Dim R = DeserializeObject(Nothing, JS, 0, ErrorInfo)
        If ErrorInfo IsNot Nothing Then
            Throw New Exception(ErrorInfo)
        End If
        Return R
    End Function
    Private Shared Function DeserializeObject(ByRef FO As Object, ByRef JS As String, ByRef P As Integer, ByRef ErrorInfo As String) As Object
        Dim isMustComma As Boolean = False
        Dim DoWhat As String = ""
        If FO IsNot Nothing Then
            If FO.GetType.Equals(GetType(Dictionary(Of String, Object))) Then
                '找Key和value和：和}
                DoWhat = "O"
            ElseIf FO.GetType.Equals(GetType(List(Of Object))) Then
                '找任何 以及，】
                DoWhat = "A"
            End If
        End If

        Do Until P >= JS.Length
            Dim C1 = JS(P)
            If C1 = "[" And isMustComma = False Then
                P += 1
                Dim R = DeserializeObject(New List(Of Object), JS, P, ErrorInfo)
                If ErrorInfo IsNot Nothing Then Return Nothing
                If DoWhat = "A" Then
                    Dim L = DirectCast(FO, List(Of Object))
                    L.Add(R)
                    isMustComma = True
                Else
                    Return R
                End If
            ElseIf C1 = "{" And isMustComma = False Then
                P += 1
                Dim R = DeserializeObject(New Dictionary(Of String, Object), JS, P, ErrorInfo)
                If ErrorInfo IsNot Nothing Then Return Nothing
                If DoWhat = "A" Then
                    Dim L = DirectCast(FO, List(Of Object))
                    L.Add(R)
                    isMustComma = True
                Else
                    Return R
                End If
            ElseIf C1 = """" And isMustComma = False Then
                P += 1
                Dim Pos = JS.IndexOf("""", P)
                If Pos < 0 Then
                    ErrorInfo = "解析字符串时未找到【""】"
                    Return Nothing
                End If
                Dim R = JS2String(JS.Substring(P, Pos - P), ErrorInfo)
                If ErrorInfo IsNot Nothing Then Return Nothing
                P = Pos + 1
                If DoWhat = "A" Then
                    Dim L = DirectCast(FO, List(Of Object))
                    L.Add(R)
                    isMustComma = True
                ElseIf DoWhat = "O" Then
                    Pos = JS.IndexOf(":", P)
                    If Pos < 0 Then
                        ErrorInfo = "解析对象时未找到【:】"
                        Return Nothing
                    End If
                    P = Pos + 1
                    Dim R2 = DeserializeObject(Nothing, JS, P, ErrorInfo)
                    If ErrorInfo IsNot Nothing Then Return Nothing
                    Dim D = DirectCast(FO, Dictionary(Of String, Object))
                    D(R) = R2
                    isMustComma = True
                Else
                    Return R
                End If
            ElseIf C1 = "," And isMustComma = True And (DoWhat = "A" Or DoWhat = "O") Then
                P += 1
                isMustComma = False
            ElseIf C1 = "]" And DoWhat = "A" Then
                P += 1
                Return FO
            ElseIf C1 = "}" And DoWhat = "O" Then
                P += 1
                Return FO
            ElseIf C1 = vbCr Or C1 = vbLf Or C1 = " " Or C1 = vbTab Then
                P += 1
            ElseIf isMustComma = False Then
                Dim Pos = JS.IndexOf("null", P, 4)
                If Pos = P Then
                    If Pos + 4 < JS.Length Then
                        C1 = JS.Substring(Pos + 4, 1)
                        If C1 = vbCr Or C1 = vbLf Or C1 = " " Or C1 = vbTab Or C1 = "]" Or C1 = "}" Or C1 = "," Then
                            P += 4
                            If DoWhat = "A" Then
                                Dim L = DirectCast(FO, List(Of Object))
                                L.Add(Nothing)
                                isMustComma = True
                            Else
                                Return Nothing
                            End If
                        End If
                    End If
                End If
                If isMustComma = False Then
                    Pos = JS.IndexOf("true", P, 4)
                    If Pos = P Then
                        If Pos + 4 < JS.Length Then
                            C1 = JS.Substring(Pos + 4, 1)
                            If C1 = vbCr Or C1 = vbLf Or C1 = " " Or C1 = vbTab Or C1 = "]" Or C1 = "}" Or C1 = "," Then
                                P += 4
                                If DoWhat = "A" Then
                                    Dim L = DirectCast(FO, List(Of Object))
                                    L.Add(True)
                                    isMustComma = True
                                Else
                                    Return True
                                End If
                            End If
                        End If
                    End If
                End If
                If isMustComma = False Then
                    Pos = JS.IndexOf("false", P, 5)
                    If Pos = P Then
                        If Pos + 5 < JS.Length Then
                            C1 = JS.Substring(Pos + 5, 1)
                            If C1 = vbCr Or C1 = vbLf Or C1 = " " Or C1 = vbTab Or C1 = "]" Or C1 = "}" Or C1 = "," Then
                                P += 5
                                If DoWhat = "A" Then
                                    Dim L = DirectCast(FO, List(Of Object))
                                    L.Add(False)
                                    isMustComma = True
                                Else
                                    Return False
                                End If
                            End If
                        End If
                    End If
                End If
                '=======判断0x模式
                If isMustComma = False Then
                    Pos = JS.IndexOf("0x", P, 2)
                    If Pos <> P Then
                        Pos = JS.IndexOf("0X", P, 2)
                    End If
                    If Pos = P Then
                        Dim HS = ""
                        Dim i = 2
                        Do
                            C1 = JS(i + P)
                            If "0123456789abcdefABCDEF".Contains(C1) Then
                                HS &= C1
                            ElseIf C1 = vbCr Or C1 = vbLf Or C1 = " " Or C1 = vbTab Or C1 = "]" Or C1 = "}" Or C1 = "," Then
                                Exit Do
                            End If
                            i += 1
                        Loop
                        Dim V As Long
                        Try
                            V = CLng("&H" & HS)
                        Catch ex As Exception
                            ErrorInfo = "十六进制转换失败"
                            Return Nothing
                        End Try
                        P += i
                        If DoWhat = "A" Then
                            Dim L = DirectCast(FO, List(Of Object))
                            L.Add(V)
                            isMustComma = True
                        Else
                            Return V
                        End If
                    End If
                End If
                '=========数字模式判断
                If isMustComma = False Then
                    If ".-0123456789".Contains(C1) Then
                        Dim HS = ""
                        Dim i = 0
                        Do
                            C1 = JS(i + P)
                            If "-.0123456789eE".Contains(C1) Then
                                HS &= C1
                            ElseIf C1 = vbCr Or C1 = vbLf Or C1 = " " Or C1 = vbTab Or C1 = "]" Or C1 = "}" Or C1 = "," Then
                                Exit Do
                            End If
                            i += 1
                        Loop
                        Dim V As Double
                        Try
                            V = CDec(HS)
                        Catch ex As Exception
                            ErrorInfo = "数字转换失败"
                            Return Nothing
                        End Try
                        P += i
                        If DoWhat = "A" Then
                            Dim L = DirectCast(FO, List(Of Object))
                            L.Add(V)
                            isMustComma = True
                        Else
                            Return V
                        End If
                    End If
                End If

                ErrorInfo = "格式内容无效"
                Return Nothing



            End If
        Loop
    End Function
    Private Shared Function JS2String(S As String, ByRef ErrorInfo As String) As String
        Try
            Do
                Dim Pos = S.IndexOf("\u")
                If Pos > -1 Then
                    Dim TS As String = S.Substring(Pos + 2, 4)
                    Dim C = ChrW("&H" & TS)
                    S = S.Substring(0, Pos) & C & S.Substring(Pos + 6)
                Else
                    Exit Do
                End If
            Loop
        Catch ex As Exception
            ErrorInfo = "解码字符串中\u内容无效"
            Return Nothing
        End Try
        S = S.Replace("\n", vbLf)
        S = S.Replace("\r", vbCr)
        S = S.Replace("\b", vbBack)
        S = S.Replace("\t", vbTab)
        S = S.Replace("\""", """")
        S = S.Replace("\\", "\")
        Return S
    End Function

    Private Shared Function String2JS(S As String) As String
        S = S.Replace("\", "\\")
        S = S.Replace("""", "\""")
        S = S.Replace(vbTab, "\t")
        S = S.Replace(vbBack, "\b")
        S = S.Replace(vbCr, "\r")
        S = S.Replace(vbLf, "\n")
        S = S.Replace(vbNullChar, "\u0000")
        Return """" & S & """"
    End Function
    Public Shared Function SerializeObject(O As Object, Optional isKey As Boolean = False) As String
        If isKey And O Is Nothing Then
            Return Nothing
        ElseIf O Is Nothing Then
            Return "null"
        End If
        Dim ThisType As Type = O.GetType
        Dim TypeName As String = ThisType.ToString.Replace("+", ".")
        Dim TN1 As String = Nothing, TN2 As String = Nothing
        Dim Pos1 As Integer = TypeName.IndexOf("[")
        Dim Pos2 As Integer = TypeName.IndexOf("]")
        If Pos2 > Pos1 And Pos1 >= 0 Then
            TN1 = TypeName.Substring(0, Pos1)
            Dim TN1A() As String = TN1.Split(".")
            TN1 = TN1A(TN1A.Length - 1).Split("`")(0)
            Dim TS As String = TypeName.Substring(Pos1 + 1, Pos2 - Pos1 - 1)
            For Each TN2N As String In TS.Split(",")
                Dim TN2NA() As String = TN2N.Split(".")
                TN2 = Trim(TN2 & " " & TN2NA(TN2NA.Length - 1).Split("`")(0))
            Next
        Else
            Dim TN1A() As String = TypeName.Split(".")
            TN1 = TN1A(TN1A.Length - 1).Split("`")(0)
        End If
        If isKey Then
            If TN1 = "String" And TN2 = "" Then
                Return String2JS(O)
            Else
                Return Nothing
            End If
        Else
            If (TN2 IsNot Nothing And TN2 = "") Or TN1 = "List" Or TN1 = "Queue" Or TN1 = "Stack" Then
                '数组实现类型 可能不全 
                Dim RS As String = "["
                For Each EO In O
                    RS = RS & SerializeObject(EO) & ","
                Next
                RS = RS.TrimEnd(",") & "]"
                Return RS
            ElseIf TN1 = "Dictionary" Then
                'Dim D As Dictionary(Of String, Object) = DirectCast(O, Dictionary(Of String, Object))
                Dim RS As String = "{"
                For Each EO As KeyValuePair(Of String, Object) In O
                    Dim TKS As String = SerializeObject(EO.Key, True)
                    If TKS IsNot Nothing Then
                        RS = RS & TKS & ":" & SerializeObject(EO.Value) & ","
                    End If
                Next
                RS = RS.TrimEnd(",") & "}"
                Return RS
            ElseIf TN1 = "Hashtable" Then
                'Dim H As Hashtable = DirectCast(O, Hashtable)
                Dim RS As String = "{"
                For Each EO As DictionaryEntry In O
                    Dim TKS As String = SerializeObject(EO.Key, True)
                    If TKS IsNot Nothing Then
                        RS = RS & TKS & ":" & SerializeObject(EO.Value) & ","
                    End If
                Next
                RS = RS.TrimEnd(",") & "}"
                Return RS
            ElseIf TN1 = "Int16" Or TN1 = "UInt16" Or
                TN1 = "Int32" Or TN1 = "UInt32" Or
                TN1 = "Int64" Or TN1 = "UInt64" Or
                TN1 = "IntPtr" Or TN1 = "UIntPtr" Or
                TN1 = "Single" Or TN1 = "Double" Or TN1 = "Decimal" Or
                TN1 = "Byte" Or TN1 = "SByte" Then
                Return O.ToString
            ElseIf TN1 = "Guid" Or TN1 = "TimeSpan" Then
                Return """" & O.ToString & """"
            ElseIf TN1 = "Boolean" Then
                Return O.ToString.ToLower
            ElseIf TN1 = "DateTime" Then
                Return """" & CDate(O).ToString("s") & """"
            ElseIf TN1 = "DateTimeOffset" Then
                Dim D As DateTimeOffset = DirectCast(O, DateTimeOffset)
                Return """" & D.ToString("s") & D.ToString("zzz") & """"
            ElseIf TN1 = "String" Or TN1 = "Char" Then
                Return String2JS(O)
            Else
                Dim FA As FieldInfo() = ThisType.GetFields
                If FA.Length > 0 Then
                    Dim RS As String = "{"
                    For Each F As FieldInfo In FA
                        If F.CustomAttributes.Any(Function(CA As CustomAttributeData) CA.AttributeType = GetType(JsonIgnore) Or CA.AttributeType.Name.Contains("JsonIgnore")) = False Then
                            RS = RS & SerializeObject(F.Name, True) & ":" & SerializeObject(F.GetValue(O)) & ","
                        End If
                    Next
                    RS = RS.TrimEnd(",") & "}"
                    Return RS
                Else
                    '此部分用于AOT或者其他平台
                    If ThisType.BaseType IsNot Nothing Then
                        If ThisType.BaseType.Name = "HappyJsonConvert" Then
                            '==========================================================================================================
                            '!!!!!!!!!上方【HappyJsonConvert】字符串必须是当前类的类名，
                            '===@@@===此部分需要放在需要序列化的类里面（或者新建一个与需要序列化类同名的部分类 Partial Public Class TestClass1）
                            'Public Function SerializeMe() As String
                            '    Dim SO As New Dictionary(Of String, Object)
                            '    SO("IP") = IP  '~~~"IP"作为要序列化的属性名称的字符串=此类的同名属性
                            '    SO("MAC") = 2  '~~~"MAC"作为要序列化的属性名称的字符串=需要的值（或此类的同名属性）
                            '    Return SerializeObject(SO)
                            'End Function
                            '===@@@===End
                            '
                            '!!!!!!!!!下方 需要手动编写，每一个要序列化的类都需要一份IF和return。
                            'If GetType(TestClass1).Name = TN1 Then                 '此行【TestClass1】必须与下面一行【TestClass1】相同
                            '    Return DirectCast(O, TestClass1).SerializeMe()     '此行【TestClass1】必须与上面一行【TestClass1】相同
                            'ElseIf GetType(TestClass2).Name = TN1 Then             '此行【TestClass2】必须与下面一行【TestClass2】相同
                            '    Return DirectCast(O, TestClass2).SerializeMe()     '此行【TestClass2】必须与上面一行【TestClass2】相同
                            'End If
                            '==========================================================================================================

                            '==========================================================================================================
                        End If
                    End If
                    Return "{}"
                End If
            End If
        End If
    End Function
End Class

以上代码 唯一就是 需要在要序列化的类里面（或者新建一个与需要序列化类同名的部分类 Partial Public Class TestClass1）增加一小段代码，并在以上提供的JSON序列化类里面修改一新增小段代码。

举例来说，假如你有以下一个自定义类TestClass1，有A、B、C三个成员，需要序列化 B、C两个成员。

 Public Class TestClass1
    Public A As Integer
    Public B As Integer
    Public C As Integer
 End Class

你需要扩展 TestClass1 类的 Partial 类：

Partial Public Class TestClass1
    Inherits HappyJsonConvert
    Public Function SerializeMe() As String
        Dim SO As New Dictionary(Of String, Object)
        SO("B") = B  '~~~"B"作为要序列化的属性名称的字符串=此类的同名属性
        SO("C") = C  '~~~"C"作为要序列化的属性名称的字符串=此类的同名属性
        Return SerializeObject(SO)
    End Function
End Class

或者修改 TestClass1 类的本身，（上面或下面任选其一）

Public Class TestClass1
    Inherits HappyJsonConvert
    Public A As Integer
    Public B As Integer
    Public C As Integer

    Public Function SerializeMe() As String
        Dim SO As New Dictionary(Of String, Object)
        SO("B") = B  '~~~"B"作为要序列化的属性名称的字符串=此类的同名属性
        SO("C") = C  '~~~"C"作为要序列化的属性名称的字符串=此类的同名属性
        Return SerializeObject(SO)
    End Function
End Class

并添加修改序列化注释最多的地方：

                '===@@@===End
                '
                '!!!!!!!!!下方 需要手动编写，每一个要序列化的类都需要一份IF和return。
                'If GetType(TestClass1).Name = TN1 Then                 '此行【TestClass1】必须与下面一行【TestClass1】相同
                '    Return DirectCast(O, TestClass1).SerializeMe()     '此行【TestClass1】必须与上面一行【TestClass1】相同
                'ElseIf GetType(TestClass2).Name = TN1 Then             '此行【TestClass2】必须与下面一行【TestClass2】相同
                '    Return DirectCast(O, TestClass2).SerializeMe()     '此行【TestClass2】必须与上面一行【TestClass2】相同
                'End If
                '==========================================================================================================
                If GetType(TestClass1).Name = TN1 Then
                    Return DirectCast(O, TestClass1).SerializeMe()
                End If
                '==========================================================================================================

然后你就能用以下代码序列化了：

Dim TC As New TestClass1 With {.A = 1, .B = 2, .C = 3}
Dim SSS = HappyJsonConvert.SerializeObject(TC)
' SSS 序列化内容为： {"A":1,"B":2,"C":3}

当然如你不添加 扩展类的部分以及不添加修改序列化注释最多的地方，你在IDE调试、编译为非aot EXE时依然能正常工作。

但是如要编译为 aot 的 EXE 就必须 添加修改这两处地方了，不然序列化无内容。

绝对原创！

——海皮智造，创我所想

​