VB NET JSON解析

最新推荐文章于 2025-07-03 12:58:08 发布

clg19780720

最新推荐文章于 2025-07-03 12:58:08 发布

阅读量2k

点赞数 6

CC 4.0 BY-SA版权

分类专栏： .NET

本文链接：https://blog.youkuaiyun.com/clg19780720/article/details/114968341

本文介绍了如何在VB.NET中实现JSON解析，作者基于JAVA的JSON解析类创建了自己的JSON解析类，包括JSON、JSONTokener、JSONStringer、JSONArray和JSONObject等，同时也提及了JavaScriptSerializer作为备用选项。提供的测试代码展示了其工作原理。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

VB NET JSON解析

这几天在做MQTT消息订阅的应用，消息公司采用JSON数据格式，于是意识兴起，自己写了一个JSON解析类，代码大部分参考JAVA的JSON解析类完成，类的命名都与JAVA的解析类完全已有，里面的方法也几乎一样，仅有少量差异。可能在一些转义符上会有点问题，这个我没有完整验证，如果右问题修改一下转义符的地方就可以了，其它都做过验证了，应该没啥大问题。完整代码如下：

JSON 类，与JAVA的JSON基本一样

Public Class JSON
    ''' <summary>
    ''' 如果输入是JSON允许的值，则返回该输入；否则抛出。
    ''' </summary>
    ''' <param name="d"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function checkDouble(ByVal d As Double) As Double
        If Double.IsInfinity(d) Or Double.IsNaN(d) Then
            Throw New Exception("Forbidden numeric value: " + d)
        End If
        Return d
    End Function
    ''' <summary>
    ''' 转为布尔型数据
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toBoolean(ByVal value As Object) As Boolean
        If value.GetType.Equals(GetType(Boolean)) Then
            Return value
        ElseIf value.GetType.Equals(GetType(String)) Then
            Dim stringValue As String = value
            If stringValue.ToLower.Equals("true") Or stringValue.ToLower.Equals("yes") Or stringValue.ToLower.Equals("on") Then
                Return True
            ElseIf stringValue.ToLower.Equals("false") Or stringValue.ToLower.Equals("no") Or stringValue.ToLower.Equals("off") Then
                Return False
            End If
        ElseIf IsNumeric(value.GetType) Then
            Return IIf(value <> 0, True, False)
        End If
        Return Nothing
    End Function
    ''' <summary>
    ''' 转为双精度数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toDouble(ByVal value As Object) As Double
        If value.GetType.Equals(GetType(Double)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CDbl(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return Double.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为单精度数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toSingle(ByVal value As Object) As Single
        If value.GetType.Equals(GetType(Single)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CSng(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return Double.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为短整型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toShort(ByVal value As Object) As Short
        If value.GetType.Equals(GetType(Short)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CShort(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return Short.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为无符号短整型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toUShort(ByVal value As Object) As UShort
        If value.GetType.Equals(GetType(UShort)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CUShort(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return UShort.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为整型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toInteger(ByVal value As Object) As Integer
        If value.GetType.Equals(GetType(Integer)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CInt(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return Integer.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为无符号整型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toUInteger(ByVal value As Object) As UInteger
        If value.GetType.Equals(GetType(UInteger)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CUInt(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return UInteger.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为长整型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toLong(ByVal value As Object) As Long
        If value.GetType.Equals(GetType(Long)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CLng(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return Long.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为无符号长整型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toULong(ByVal value As Object) As ULong
        If value.GetType.Equals(GetType(ULong)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CULng(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return ULong.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为字节型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toByte(ByVal value As Object) As Byte
        If value.GetType.Equals(GetType(Byte)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CByte(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return Byte.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为无符号字节型数字
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toSByte(ByVal value As Object) As SByte
        If value.GetType.Equals(GetType(SByte)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CSByte(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return SByte.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为字符型
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function toChar(ByVal value As Object) As Char
        If value.GetType.Equals(GetType(SByte)) Then
            Return value
        ElseIf IsNumeric(value.GetType) Then
            Return CChar(value)
        ElseIf value.GetType.Equals(GetType(String)) Then
            Return Char.Parse(value)
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 转为字符串
    ''' </summary>
    ''' <param name="value"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overloads Shared Function toString(ByVal value As Object) As String
        If value.GetType.Equals(GetType(String)) Then
            Return value
        ElseIf Not IsNothing(value) Then
            Return value.ToString()
        Else
            Return Nothing
        End If
    End Function

    Public Shared Function typeMismatch(ByVal indexOrName As Object, ByVal actual As Object, ByVal requiredType As String) As Exception
        If IsNumeric(actual) Then
            Throw New Exception("Value at " + indexOrName + " is null.")
        Else
            Throw New Exception("Value " + actual + " at " + indexOrName + " of type " + actual.getClass().getName() + " cannot be converted to " + requiredType)
        End If
    End Function
    Public Shared Function typeMismatch(ByVal actual As Object, ByVal requiredType As String) As Exception
        If IsNumeric(actual) Then
            Throw New Exception("Value is null.")
        Else
            Throw New Exception("Value " + actual + " of type " + actual.getClass().getName() + " cannot be converted to " + requiredType)
        End If
    End Function

    ''' <summary>
    ''' 类型是数字类型
    ''' </summary>
    ''' <param name="dataType">类型</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function IsNumeric(ByVal dataType As Type) As Boolean
        If Microsoft.VisualBasic.IsNothing(dataType) Then
            Return False
        Else
            Return dataType.Equals(GetType(Byte)) Or dataType.Equals(GetType(SByte)) Or dataType.Equals(GetType(Char)) Or _
                   dataType.Equals(GetType(Short)) Or dataType.Equals(GetType(UShort)) Or dataType.Equals(GetType(Integer)) Or _
                   dataType.Equals(GetType(UInteger)) Or dataType.Equals(GetType(Long)) Or dataType.Equals(GetType(ULong)) Or _
                   dataType.Equals(GetType(Single)) Or dataType.Equals(GetType(Double)) Or dataType.Equals(GetType(Int16)) Or _
                   dataType.Equals(GetType(Int32)) Or dataType.Equals(GetType(Int64)) Or dataType.Equals(GetType(UInt16)) Or _
                   dataType.Equals(GetType(UInt32)) Or dataType.Equals(GetType(UInt64)) Or dataType.Equals(GetType(UIntPtr))
        End If
    End Function
End Class

JSONTokener类。与JAVA的JSONTokener一致。主要是用于将json字符串解析为JSONObject或JSONArray类数据

Imports System.Text

Public Class JSONTokener
    ''' <summary>输入JSON </summary>
    Private input As String
    ''' <summary>返回的下一个字符的索引。当输入用尽时，这等于输入的长度。</summary>
    Private pos As Integer
    ''' <summary>
    ''' 构造函数
    ''' </summary>
    ''' <param name="json">JSON编码字符串。不允许Null，它将产生一个令牌，在调用方法时抛出<code>Exceptions</code>。</param>
    ''' <remarks></remarks>
    Public Sub New(ByVal json As String)
        If Not IsNothing(json) Then
            '如果存在，则使用可选的字节顺序标记（BOM）。
            If json.StartsWith((Chr(254) + Chr(255))) Then   '"\ufeff"
                json = json.Substring(1)
            End If
        End If
        Me.input = json
    End Sub
    ''' <summary>
    ''' 返回输入的下一个值。
    ''' </summary>
    ''' <returns>
    ''' <code>JSONObject</code>、<code>JSONArray</code>、String、Boolean、Integer、Long、Double或<code>JSONObject.NULL</code>。
    ''' </returns>
    ''' <remarks></remarks>
    ''' <exception cref="Exception"></exception>
    Public Function NextValue() As Object
        Dim c As Integer = NextCleanInternal()
        Select Case c
            Case -1
                Throw syntaxError("End of input")
            Case Asc("{")
                Return ReadObject()
            Case Asc("[")
                Return ReadArray()
            Case Asc("'"), Asc("""")
                Return NextString(Chr(c))
            Case Else
                pos -= 1
                Return ReadLiteral()
        End Select
    End Function

    Private Function NextCleanInternal() As Integer
        While pos < input.Length
            Dim c As Char = input.Chars(pos)
            pos += 1
            Select Case c
                Case vbTab, " ", vbLf, vbCr
                    Continue While
                Case "/"
                    If pos = input.Length Then
                        Return Asc(c)
                    End If
                    Dim peek As Char = input.Chars(pos)
                    Select Case peek
                        Case "*"
                            '跳过/*C样式的注释*/
                            pos += 1
                            Dim commentEnd As Integer = input.IndexOf("*/", pos)
                            If commentEnd = -1 Then
                                Throw syntaxError("Unterminated comment")
                            End If
                            pos = commentEnd + 2
                            Continue While
                        Case "/"
                            pos += 1
                            SkipToEndOfLine()
                            Continue While
                        Case Else
                            Return Asc(c)
                    End Select
                Case "#"
                    '跳过#散列行尾注释。JSON RFC没有指定这种行为，但是需要解析现有文档。参见：http://b/2571423。
                    SkipToEndOfLine()
                    Continue While
                Case Else
                    Return Asc(c)
            End Select
        End While
        Return -1
    End Function
    ''' <summary>
    ''' 将位置前进到下一个换行符之后。如果该行以"\r\n"结尾，则调用者必须将"\n"用作空白。
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub SkipToEndOfLine()
        Do While pos < input.Length
            Dim c As Char = input.Chars(pos)
            If c = vbCr Or c = vbLf Then
                pos += 1
                Exit Do
            End If
            pos += 1
        Loop
    End Sub
    ''' <summary>
    ''' 返回到但不包括<code>quote</code>的字符串，不跳过沿途遇到的任何字符转义序列。开场白应该已经读过了。这将使用结束引号，但不会将其包含在返回的字符串中。
    ''' </summary>
    ''' <param name="quote">'或"</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function NextString(ByVal quote As Char) As String
        '对于没有转义序列的字符串，我们可以将结果提取为输入的子字符串。但如果遇到转义序列，则需要使用StringBuilder来合成结果。
        Dim builder As StringBuilder = Nothing
        '尚未附加到生成器的第一个字符的索引
        Dim start As Integer = pos
        While pos < input.Length
            Dim c As Char = input.Chars(pos)
            pos += 1
            If c = quote Then
                If IsNothing(builder) Then
                    '新字符串避免内存泄漏
                    Return New String(input.Substring(start, (pos - 1) - start))
                Else
                    builder.Append(input, start, pos - 1)
                    Return builder.ToString()
                End If
            End If
            If c = "\" Then
                If pos = input.Length Then
                    Throw syntaxError("Unterminated escape sequence")
                End If
                If IsNothing(builder) Then
                    builder = New StringBuilder()
                End If
                builder.Append(input, start, pos - 1)
                builder.Append(ReadEscapeCharacter())
                start = pos
            End If
        End While
        Throw syntaxError("Unterminated string")
    End Function
    ''' <summary>
    ''' 取消由紧跟在反斜杠后面的一个或多个字符标识的字符。应该已经读取了反斜杠“\”。这支持unicode转义“u000A”和两个字符转义“\n”。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadEscapeCharacter() As Char
        Dim escaped As Char = input.Chars(pos)
        pos += 1
        Select Case escaped
            Case "u"
                If pos + 4 > input.Length Then
                    Throw syntaxError("Unterminated escape sequence")
                End If
                Dim hex As String = input.Substring(pos, 4)
                pos += 4
                Try
                    Return Chr(Integer.Parse(hex, 16))
                Catch ex As Exception
                    Throw syntaxError("Invalid escape sequence: " + hex)
                End Try
            Case "t"
                Return vbTab
            Case "b"
                Return vbBack
            Case "n"
                Return vbLf
            Case "r"
                Return vbCr
            Case "f"
                Return vbFormFeed
            Case "'", """", "\"
                Return escaped
            Case Else
                Return escaped
        End Select
    End Function
    ''' <summary>
    ''' 读取空值、布尔值、数值或无引号的字符串文本值。数值将以整数、Long或Double的形式按优先顺序返回。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadLiteral() As Object
        Dim literal As String = NextToInternal("{}[]/\:,=;# tf")
        If literal.Length = 0 Then
            Throw syntaxError("Expected literal value")
        ElseIf literal.ToLower = "null" Then
            Return "null"
        ElseIf literal.ToLower = "true" Then
            Return "true"
        ElseIf literal.ToLower = "false" Then
            Return "false"
        End If
        '尝试作为整型进行分析
        If literal.IndexOf(".") = -1 Then
            Dim base As Integer = 10
            Dim number As String = literal
            If (number.StartsWith("0x") Or number.StartsWith("0X")) Then
                number = number.Substring(2)
                base = 16
            ElseIf (number.StartsWith("0") And number.Length() > 1) Then
                number = number.Substring(1)
                base = 8
            End If
            Try
                Dim longValue As Long = Long.Parse(number, base)
                If longValue <= Integer.MaxValue And longValue >= Integer.MinValue Then
                    Return CInt(longValue)
                Else
                    Return longValue
                End If
            Catch ex As Exception
                '这只发生在大于长最大值，指数形式的数字（5e-10）和不带引号的字符串。尝试浮点运算。
            End Try
        End If
        Try
            Return Double.Parse(literal)
        Catch ex As Exception
        End Try
        '最后放弃。我们有一个未引号的字符串
        Return New String(literal) '新字符串可避免内存泄漏
    End Function
    ''' <summary>
    ''' 返回字符串，但不包括给定字符或换行符中的任何字符。这不会消耗被排除的字符。
    ''' </summary>
    ''' <param name="excluded"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function NextToInternal(excluded As String) As String
        Dim start As Integer = pos
        Do While pos < input.Length
            Dim c As Char = input.Chars(pos)
            If c = vbCr Or c = vbLf Or excluded.IndexOf(c) <> -1 Then
                'Substring(start, pos)修改为下面。因为在net中Substring（开始，长度），java中Substring（开始，结束）,所以这里应该是用结束位置-开始位置
                Return input.Substring(start, pos - start)
            End If
            pos += 1
        Loop
        Return input.Substring(start)
    End Function
    ''' <summary>
    ''' 读取对象的键/值对序列和尾随右大括号'}'。应该已经读取了左大括号“{”。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadObject() As JSONObject
        Dim result As JSONObject = New JSONObject()
        Dim first As Integer = NextCleanInternal()
        If Chr(first) = "}" Then
            Return result
        ElseIf first <> -1 Then
            pos -= 1
        End If
        While True
            Dim name As Object = NextValue()
            If Not name.GetType.Equals(GetType(String)) Then
                If IsNothing(name) Then
                    Throw syntaxError("Names cannot be null")
                Else
                    Throw syntaxError("Names must be strings, but " + name.ToString + " is of type " + name.GetType.Name)
                End If
            End If
            Dim separator As Integer = NextCleanInternal()
            If Chr(separator) <> ":" And Chr(separator) <> "=" Then
                Throw syntaxError("Expected ':' after " + name)
            End If
            If pos < input.Length Then
                If input.Chars(pos) = ">" Then
                    pos += 1
                End If
            End If
            result.put(name, NextValue())
            Dim ci As Integer = NextCleanInternal()
            Select Case ci
                Case Asc("}")
                    Return result
                Case Asc(";"), Asc(",")
                    Continue While
                Case Else
                    Throw syntaxError("Unterminated object")
            End Select
        End While
        Return result
    End Function
    ''' <summary>
    ''' 读取数组的值序列和尾随右大括号']'。应该已经读取了左大括号“[”。注意，“[]”产生一个空数组，但是“[，]”返回一个与“[null，null]”等价的两元素数组。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadArray() As Object
        Dim result As JSONArray = New JSONArray()
        Dim hasTrailingSeparator As Boolean = False
        While True
            Dim ci As Integer = NextCleanInternal()
            Select Case ci
                Case -1
                    Throw syntaxError("Unterminated array")
                Case Asc("]")
                    If hasTrailingSeparator Then
                        Dim obj As Object = Nothing
                        result.put(obj)
                    End If
                    Return result
                Case Asc(","), Asc(";")
                    '没有值的分隔符首先表示“null”。
                    Dim obj As Object = Nothing
                    result.put(obj)
                    hasTrailingSeparator = True
                    Continue While
                Case Else
                    pos -= 1
            End Select
            result.put(NextValue())
            ci = NextCleanInternal()
            Select Case ci
                Case Asc("]")
                    Return result
                Case Asc(","), Asc(";")
                    hasTrailingSeparator = True
                    Continue While
                Case Else
                    Throw syntaxError("Unterminated array")
            End Select
        End While
        Return result
    End Function

    Private Function syntaxError(ByVal message As String) As Exception
        Return New Exception(message + Me.GetType.Name)
    End Function
    ''' <summary>
    ''' 返回当前位置和整个输入字符串。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overrides Function toString() As String
        Return " at character " + pos + " of " + input
    End Function
    ''' <summary>
    ''' 返回true，直到输入用尽为止。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function more() As Boolean
        Return pos < input.Length()
    End Function
    ''' <summary>
    ''' 返回下一个可用字符，如果已用尽所有输入，则返回空字符“\0”。对于包含字符“\0”的JSON字符串，此方法的返回值不明确。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextChar() As Char
        Dim result As Char = IIf(pos < input.Length(), input.Chars(pos), Chr(0))
        pos += 1
        Return result
    End Function
    ''' <summary>
    ''' 如果下一个可用字符等于<code>c</code>，则返回该字符。否则会引发异常。
    ''' </summary>
    ''' <param name="c"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextChar(ByVal c As Char) As Char
        Dim result As Char = nextChar()
        If result <> c Then
            Throw syntaxError("Expected " + c + " but was " + result)
        End If
        Return result
    End Function
    ''' <summary>
    ''' 返回下一个非空白且不属于注释的字符。如果在找到这样一个字符之前输入已用尽，则返回空字符'\0'。对于包含字符“\0”的JSON字符串，此方法的返回值不明确。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextClean() As Char
        Dim nextCleanInt As Integer = NextCleanInternal()
        Return IIf(nextCleanInt = -1, Chr(0), Chr(nextCleanInt))
    End Function
    ''' <summary>
    ''' 返回输入的下一个{@code length}字符。
    ''' 返回的字符串与此标记器的输入字符串共享其支持字符数组。
    ''' 如果对返回字符串的引用可能被无限保留，那么应该首先使用{@code new string（result）}复制它，
    ''' 以避免内存泄漏。
    ''' </summary>
    ''' <param name="length"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextString(ByVal length As Integer) As String
        If pos + length > input.Length Then
            Throw syntaxError(length + " is out of bounds")
        End If
        Dim result As String = input.Substring