精华内容
下载资源
问答
  • VB 写json报文

    千次阅读 2018-09-07 09:32:22
     Dim oJObject As Newtonsoft.Json.Linq.JObject = Newtonsoft.Json.JsonConvert.DeserializeObject(strEDI)  If oJObject Is Nothing Then  oResult.OK = False  oResult.ErrorMessage = "解析Json错误!" ...

        Public Function SubEDI_FMSQuotation(ByVal G_objService As AWSysBase.SysServer, ByVal strEDI As String, ByVal oResult As EDIResult, ByVal oEDIOpType As Tatium.AWSysPrevlige.SysEDIOpMTType) As Boolean
            Try
                Dim strErrorMsg As String = ""
                Dim oJObject As Newtonsoft.Json.Linq.JObject = Newtonsoft.Json.JsonConvert.DeserializeObject(strEDI)
                If oJObject Is Nothing Then
                    oResult.OK = False
                    oResult.ErrorMessage = "解析Json错误!"
                    Return False
                End If


                Dim strMyUserCode As String = ""
                Dim strMyUserPwd As String = ""
                Dim QuotationCode As String = ""

                Dim oToken As Newtonsoft.Json.Linq.JToken

                oToken = oJObject(SubMakeInKeyWord("UserCode"))
                If Not oToken Is Nothing Then
                    strMyUserCode = oToken.ToString()
                End If
                oToken = oJObject(SubMakeInKeyWord("UserPwd"))
                If Not oToken Is Nothing Then
                    strMyUserPwd = oToken.ToString()
                End If
                oToken = oJObject(SubMakeInKeyWord("QuotationCode"))
                If Not oToken Is Nothing Then
                    QuotationCode = oToken.ToString()
                End If
                Dim QuotationCodenum As Integer = QuotationCode.Length
                Dim QuotationCod As String = ""
                If QuotationCodenum = 11 Then
                    QuotationCod = "'" & QuotationCode & "'"
                Else
                    Dim num As Integer = 0
                    While QuotationCodenum > 0 And num < 120
                        QuotationCod += "'" & QuotationCode.Substring(num, 11) & "'" & ","
                        num += 12
                        QuotationCodenum -= 12
                    End While
                    QuotationCod = QuotationCod.Substring(0, QuotationCod.Length - 1)
                End If
                If EDI_FMSCheckUser(strMyUserCode, strMyUserPwd) = False Then
                    oResult.OK = False
                    oResult.ErrorMessage = "不是合法ID,不能调用当前接口,请联系供应商确认相关问题!"
                    Return False
                End If
                'Dim strSQL As String = "select OfferUsedID from OfferUsed   where UsedCode='" & QuotationCode & "'"

                'Dim oData As ADODB.Recordset = G_objService.DB_ExecSelectSQLTable(strSQL)

                'Dim OfferUse As New AWFMSMain.OfferUsed

                'OfferUse.SetService(G_objService)
                'If OfferUse.LoadFromDB(G_objService.SB_MyTrim(oData.Fields("OfferUsedID").Value)) = False Then
                '    oResult.OK = False
                '    oResult.ErrorMessage = "未能查到相关数据!"
                '    Return False
                'End If
                Dim oStringBuilder As New System.Text.StringBuilder()
                Dim oStringWriter As New System.IO.StringWriter(oStringBuilder)
                'If OfferUse.LoadFromDB(G_objService.SB_MyTrim(oData.Fields("OfferUsedID").Value)) = True Then
                Using oJsonWriter As New Newtonsoft.Json.JsonTextWriter(oStringWriter)
                    oJsonWriter.Formatting = Newtonsoft.Json.Formatting.None
                    'oJsonWriter.WriteStartArray()
                    oJsonWriter.WriteStartObject()
                    oJsonWriter.WritePropertyName("RetStatus")
                    oJsonWriter.WriteValue("1")
                    oJsonWriter.WritePropertyName("RetMsg")
                    oJsonWriter.WriteValue("成功!")
                    oJsonWriter.WritePropertyName("RetMsgCode")
                    oJsonWriter.WriteValue("")
                    oJsonWriter.WritePropertyName("RetOrderCode")
                    oJsonWriter.WriteValue("")
                    oJsonWriter.WritePropertyName("RetID")
                    oJsonWriter.WriteValue("")
                    oJsonWriter.WritePropertyName("RetData")
                    oJsonWriter.WriteStartObject()
                    oJsonWriter.WritePropertyName("Quotation")
                    oJsonWriter.WriteStartArray()

                    Dim strSQL As String = "select * from OfferUsed  where UsedCode in (" & QuotationCod & ")"

                    Dim OfferUse As ADODB.Recordset = G_objService.DB_ExecSelectSQL(strSQL)
                    If OfferUse.RecordCount >= 1 Then

                        While Not OfferUse.EOF
                            oJsonWriter.WriteStartObject()
                            oJsonWriter.WritePropertyName("QuotationCode")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("UsedCode").Value))
                            oJsonWriter.WritePropertyName("Creator")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("Creator").Value))
                            oJsonWriter.WritePropertyName("Create_Date")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("CreateDate").Value))
                            oJsonWriter.WritePropertyName("Origin_Country")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("LoadCountryNo").Value))
                            oJsonWriter.WritePropertyName("Origin_City")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("UsedLoad").Value))
                            oJsonWriter.WritePropertyName("Destination_Country")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("DestCountryNo").Value))
                            oJsonWriter.WritePropertyName("Destination_ZipCode")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("DestZipCode").Value))
                            oJsonWriter.WritePropertyName("Container_Type")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("ContainerTypeNo").Value))
                            oJsonWriter.WritePropertyName("Container_Number")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("ContainerNum").Value))
                            oJsonWriter.WritePropertyName("Quantity")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("FCLLCLFlag").Value))
                            oJsonWriter.WritePropertyName("Volumn")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("Volumn").Value))
                            oJsonWriter.WritePropertyName("Weight")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("Weight").Value))
                            oJsonWriter.WritePropertyName("Pallet")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("Pallet").Value))
                            oJsonWriter.WritePropertyName("Agent_NameC")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("CustomerName").Value))
                            Dim str1 As String = "select PortNameE as A  from MTPort where PortNo='" & G_objService.SB_MyTrim(OfferUse.Fields("AgentNo").Value) & "'"

                            Dim num As ADODB.Recordset = G_objService.DB_ExecSelectSQL(str1)
                            oJsonWriter.WritePropertyName("Agent_NameE")
                            If num.RecordCount >= 1 Then
                                oJsonWriter.WriteValue(G_objService.SB_MyTrim(num.Fields("A").Value))
                            Else
                                oJsonWriter.WriteValue("")
                            End If

                            oJsonWriter.WritePropertyName("Agent_Contact")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("Contactor").Value))
                            oJsonWriter.WritePropertyName("Agent_Tel")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("Phone").Value))
                            oJsonWriter.WritePropertyName("Agent_Email")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("Mail").Value))
                            oJsonWriter.WritePropertyName("Agent_Address")
                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferUse.Fields("CustomerAddress").Value))
                            oJsonWriter.WritePropertyName("Freight_Amount")
                            str1 = "select  SUM(Amount) as A from OfferUsedItem where OfferUsedID='" & G_objService.SB_MyTrim(OfferUse.Fields("OfferUsedID").Value) & "' and  OfferSundryFlag=0"

                            num = G_objService.DB_ExecSelectSQL(str1)
                            If num.RecordCount >= 1 Then
                                oJsonWriter.WriteValue(G_objService.SB_MyTrim(num.Fields("A").Value))
                            Else
                                oJsonWriter.WriteValue("")
                            End If
                            oJsonWriter.WritePropertyName("Incidental_Amount")
                            str1 = "select  SUM(Amount) as A from OfferUsedItem where OfferUsedID='" & G_objService.SB_MyTrim(OfferUse.Fields("OfferUsedID").Value) & "' and  OfferSundryFlag=1"
                            num = G_objService.DB_ExecSelectSQL(str1)
                            If num.RecordCount >= 1 Then
                                oJsonWriter.WriteValue(G_objService.SB_MyTrim(num.Fields("A").Value))
                            Else
                                oJsonWriter.WriteValue("")
                            End If
                            oJsonWriter.WritePropertyName("Total_Amount")
                            str1 = "select  SUM(Amount) as A from OfferUsedItem where OfferUsedID='" & G_objService.SB_MyTrim(OfferUse.Fields("OfferUsedID").Value) & "'"
                            num = G_objService.DB_ExecSelectSQL(str1)
                            If num.RecordCount >= 1 Then
                                oJsonWriter.WriteValue(G_objService.SB_MyTrim(num.Fields("A").Value))
                            Else
                                oJsonWriter.WriteValue("")
                            End If
                            oJsonWriter.WritePropertyName("Amount_Remark")
                            oJsonWriter.WriteValue("此报价中不包含税金、代收代付等相关实报实销费用。")
                            oJsonWriter.WritePropertyName("Transport")
                            oJsonWriter.WriteStartArray()
                            Dim strSQLm As String = "select * from OfferMain  where OfferMainID in (" & G_objService.SB_MyTrim(OfferUse.Fields("OfferOneID").Value) & "," & G_objService.SB_MyTrim(OfferUse.Fields("OfferTwoID").Value) & "," & G_objService.SB_MyTrim(OfferUse.Fields("OfferThreeID").Value) & ")"

                            Dim OfferMai As ADODB.Recordset = G_objService.DB_ExecSelectSQL(strSQLm)
                            If OfferMai.RecordCount >= 1 Then

                                While Not OfferMai.EOF
                                    oJsonWriter.WriteStartObject()
                                    oJsonWriter.WritePropertyName("POL_Country")
                                    oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferMai.Fields("LoadCountyNo").Value))
                                    oJsonWriter.WritePropertyName("POL")
                                    str1 = "select PortNameE as A from MTPort   where PortNo='" & G_objService.SB_MyTrim(OfferMai.Fields("LoadPortNo").Value) & "'"
                                    num = G_objService.DB_ExecSelectSQL(str1)
                                    If num.RecordCount >= 1 Then
                                        oJsonWriter.WriteValue(G_objService.SB_MyTrim(num.Fields("A").Value))
                                    Else
                                        oJsonWriter.WriteValue("")
                                    End If
                                    oJsonWriter.WritePropertyName("POD_Country")
                                    oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferMai.Fields("DestCountyNo").Value))
                                    oJsonWriter.WritePropertyName("POD")
                                    str1 = "select PortNameE as A from MTPort   where PortNo='" & G_objService.SB_MyTrim(OfferMai.Fields("DestinationPortNo").Value) & "'"
                                    num = G_objService.DB_ExecSelectSQL(str1)
                                    If num.RecordCount >= 1 Then
                                        oJsonWriter.WriteValue(G_objService.SB_MyTrim(num.Fields("A").Value))
                                    Else
                                        oJsonWriter.WriteValue("")
                                    End If
                                    oJsonWriter.WritePropertyName("Carrier")
                                    oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferMai.Fields("CarrierNo").Value))
                                    oJsonWriter.WritePropertyName("Mode_Of_Transport")
                                    oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferMai.Fields("TransitPortNo").Value))
                                    oJsonWriter.WritePropertyName("Valid_Date")
                                    oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferMai.Fields("ValidOverDate").Value))
                                    oJsonWriter.WritePropertyName("Note")
                                    oJsonWriter.WriteValue(G_objService.SB_MyTrim(OfferMai.Fields("Note").Value))
                                    oJsonWriter.WritePropertyName("FeeList")
                                    oJsonWriter.WriteStartArray()


                                    Dim strSQLit As String = "select (Amount*Rate) as A,*from OfferUsedItem where OfferUsedID='" & G_objService.SB_MyTrim(OfferUse.Fields("OfferUsedID").Value) & "'"

                                    Dim ooData As ADODB.Recordset = G_objService.DB_ExecSelectSQL(strSQLit)
                                    If ooData.RecordCount >= 1 Then

                                        While Not ooData.EOF
                                            oJsonWriter.WriteStartObject()
                                            oJsonWriter.WritePropertyName("Fee_Name")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("FeeTypeNo").Value))
                                            oJsonWriter.WritePropertyName("Fee_Type")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("TransType").Value))
                                            oJsonWriter.WritePropertyName("Currency")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("CurrencyType").Value))
                                            oJsonWriter.WritePropertyName("Price")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("Price").Value))
                                            oJsonWriter.WritePropertyName("Unit_Type")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("UnitType").Value))
                                            oJsonWriter.WritePropertyName("Unit")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("Unit").Value))
                                            oJsonWriter.WritePropertyName("Amount")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("Amount").Value))
                                            oJsonWriter.WritePropertyName("Exchange_Rate")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("Rate").Value))
                                            oJsonWriter.WritePropertyName("Amount_USD")
                                            oJsonWriter.WriteValue(G_objService.SB_MyTrim(ooData.Fields("A").Value))
                                            oJsonWriter.WriteEndObject()
                                            ooData.MoveNext()
                                        End While
                                    End If
                                    oJsonWriter.WriteEndArray()
                                    oJsonWriter.WriteEndObject()
                                    OfferMai.MoveNext()
                                End While
                            End If
                            oJsonWriter.WriteEndArray()
                            oJsonWriter.WriteEndObject()
                            OfferUse.MoveNext()
                        End While
                    End If
                    oJsonWriter.WriteEndArray()
                    oJsonWriter.WriteEndObject()
                    oJsonWriter.WriteEndObject()
                End Using

                oResult.OK = True
                oResult.DataContent = oStringBuilder.ToString()

                Dim oSendResult As New EDIResult

                '不需要发送给客户,该接口为客户自己调
                'Dim bRet As Boolean = SubHTTPPostData(G_objService, oEDIOpType.MTSendURL, oEDIOpType.MTSendParaOther, oEDIOpType.MTSendParaData, strRet, oSendResult)

                Dim oEDILog As New Tatium.AWSysPrevlige.SysEDIOpMain
                oEDILog.SetService(G_objService)

                oEDILog.MakeEDIResult(oEDIOpType.EDIOpTypeIdx, True, 1, "生成数据成功!", -1, -1, oResult.MainKey, oStringBuilder.ToString(), "", "URL:" & oEDIOpType.MTSendURL)
                Return True
            Catch ex As Exception
                G_objService.Sys_WriteDebug("FMS.GetQuotation", ex.Message)
                oResult.OK = False
                oResult.ErrorMessage = ex.Message
                Return False
            End Try

        End Function

     

    展开全文
  • VB NET JSON解析

    2021-03-18 10:54:18
    这几天在做MQTT消息订阅的应用,消息公司采用JSON数据格式,于是意识兴起,自己了一个JSON解析类,代码大部分参考JAVA的JSON解析类完成,类的命名都与JAVA的解析类完全已有,里面的方法也几乎一样,仅有少量差异。...

    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(pos, length)
            pos += length
            Return result
        End Function
        ''' <summary>
        ''' 返回{@link String#trim trimmed}字符串,其中包含最多但不包括以下第一个字符:
        ''' {@code excluded}中的任何字符
        ''' 换行符“\n”
        ''' 回车“\r”
        ''' 返回的字符串与此标记器的输入字符串共享其支持字符数组。
        ''' 如果对返回字符串的引用可能被无限期保留,那么应该首先
        ''' 使用{@code new string(result)}复制它,以避免内存泄漏。
        ''' </summary>
        ''' <param name="excluded"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function nextStringTo(ByVal excluded As String) As String
            If excluded Is Nothing Then
                Throw New Exception("excluded == null")
            End If
            Return NextToInternal(excluded).Trim()
        End Function
        ''' <summary>
        ''' 相当于{@code nextStringTo(String.valueOf值(不包括在内)。
        ''' </summary>
        ''' <param name="excluded"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function nextCharTo(ByVal excluded As Char) As String
            Return NextToInternal(excluded)
        End Function
        ''' <summary>
        ''' 将所有输入向前推进,直到并包括下一次出现的{@code thru}。如果剩余的输入不包含{@code thru},则输入将用尽。
        ''' </summary>
        ''' <param name="thru"></param>
        ''' <remarks></remarks>
        Public Sub skipPast(ByVal thru As String)
            Dim thruStart As Integer = input.IndexOf(thru, pos)
            pos = IIf(thruStart = -1, input.Length(), (thruStart + thru.Length()))
        End Sub
        ''' <summary>
        ''' 超过所有输入,但不包括下一次出现的{@code to}。如果剩余的输入不包含{@code to},则输入不变。
        ''' </summary>
        ''' <param name="charto"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function skipTo(ByVal charto As Char) As Char
            Dim index As Integer = input.IndexOf(charto, pos)
            If index <> -1 Then
                pos = index
                Return charto
            Else
                Return Chr(Asc(0))
            End If
        End Function
        ''' <summary>
        ''' 未读输入的最新字符。如果没有读取输入字符,则输入不变。
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub back()
            pos -= 1
            If (pos = -1) Then
                pos = 0
            End If
        End Sub
        ''' <summary>
        ''' 对于给定的十六进制字符,返回整数[0..15]值;对于非十六进制输入,返回-1。
        ''' </summary>
        ''' <param name="hex">在[0-9]、[a-F]或[a-f]范围内的字符。任何其他字符将产生-1结果。</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Shared Function dehexchar(ByVal hex As Char) As Integer
            ' Dim zero As Char = "0"
            Dim intHex As Integer = Asc(hex)
            If intHex >= Asc("0") And intHex <= Asc("0") Then
                Return Asc(hex) - Asc("0")
            ElseIf intHex >= Asc("A") And intHex <= Asc("F") Then
                Return Asc(hex) - Asc("A") + 10
            ElseIf intHex >= Asc("a") And intHex <= Asc("f") Then
                Return Asc(hex) - Asc("a") + 10
            Else
                Return -1
            End If
        End Function
    End Class
    

    JSONStringer类。与javaJSONStringer类相同,主要是将JSONObject解析为json字符串。

    Imports System.Text
    
    Public Class JSONStringer
        ''' <summary>
        ''' 输出数据,最多包含一个顶级数组或对象。
        ''' </summary>
        ''' <remarks></remarks>
        Friend out As StringBuilder = New StringBuilder()
    
        ''' <summary>左方括号</summary>
        Private Const BRACKETS_CURLY_LEFT = "{"
        ''' <summary>右方括号</summary>
        Private Const BRACKETS_CURLY_RIGHT = "}"
        ''' <summary>左方括号</summary>
        Private Const BRACKETS_SQUARE_LEFT = "["
        ''' <summary>右方括号</summary>
        Private Const BRACKETS_SQUARE_RIGHT = "]"
        ''' <summary>双引号</summary>
        Private Const DOUNLE_QUOTATION_MARK = """"
        ''' <summary>逗号</summary>
        Private Const COMMA = ","
        ''' <summary>冒号</summary>
        Private Const COLON = ":"
        ''' <summary>冒号和空格</summary>
        Private Const COLON_AND_SPACE = ": "
        ''' <summary>空格</summary>
        Private Const SPACE = " "
        ''' <summary>
        ''' 范围
        ''' </summary>
        ''' <remarks></remarks>
        Enum Scope
            ''' <summary>没有元素的数组在关闭之前不需要分隔符或换行符。</summary>
            EMPTY_ARRAY = 0
            ''' <summary>至少有一个值的数组需要在下一个元素前加逗号和换行符。</summary>
            NONEMPTY_ARRAY = 1
            ''' <summary>没有键或值的对象在关闭前不需要分隔符或换行符。</summary>
            EMPTY_OBJECT = 2
            ''' <summary>其最新元素是键的对象。下一个元素必须是值。</summary>
            DANGLING_KEY = 3
            ''' <summary>至少有一个名称/值对的对象在下一个元素之前需要逗号和换行符。</summary>
            NONEMPTY_OBJECT = 4
            ''' <summary>一种特殊的无支架数组JSONStringer.join连接()和JSONObject.quote文件()仅限。不用于JSON编码。</summary>
            NULL = 5
        End Enum
        ''' <summary>
        ''' 与最初的实现不同,这个堆栈不限于20层嵌套。
        ''' </summary>
        ''' <remarks></remarks>
        Dim stack As List(Of Scope) = New List(Of Scope)
        ''' <summary>
        ''' 一个字符串,包含一个完整的空格集,用于一个缩进级别,如果没有漂亮的打印,则为nothing。
        ''' </summary>
        ''' <remarks></remarks>
        Dim indent As String
        Public Sub New()
            indent = Nothing
        End Sub
        Public Sub New(ByVal indentSpaces As Integer)
            Dim indentChars(indentSpaces) As Char
            For i = 0 To indentChars.Count - 1
                indentChars(i) = SPACE
            Next
            indent = New String(indentChars)
        End Sub
        ''' <summary>
        ''' 开始编码新数组。对该方法的每个调用必须与对<code>endArray</code>的调用配对。
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function startArray() As JSONStringer
            Return open(Scope.EMPTY_ARRAY, BRACKETS_SQUARE_LEFT)
        End Function
        ''' <summary>
        ''' 结束对当前数组的编码。
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function endArray() As JSONStringer
            Return close(Scope.EMPTY_ARRAY, Scope.NONEMPTY_ARRAY, BRACKETS_SQUARE_RIGHT)
        End Function
        ''' <summary>
        ''' 开始编码新对象。对该方法的每个调用必须与对<code>endObject</code>的调用配对。
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function startObject() As JSONStringer
            Return open(Scope.EMPTY_OBJECT, BRACKETS_CURLY_LEFT)
        End Function
        ''' <summary>
        ''' 结束对当前对象的编码。
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function endObject() As JSONStringer
            Return close(Scope.EMPTY_OBJECT, Scope.NONEMPTY_OBJECT, BRACKETS_CURLY_RIGHT) '"}")
        End Function
        ''' <summary>
        ''' 编码<code>val</code>。
        ''' </summary>
        ''' <param name="val">
        ''' <code>JSONObject</code>、<code>JSONArray</code>、String、Boolean、Integer、Long、Double或null。。
        ''' </param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function value(ByVal val As Object) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            If val.GetType.Equals(GetType(JSONArray)) Then
                val.writeTo(Me)
                Return Me
            ElseIf val.GetType.Equals(GetType(JSONObject)) Then
                val.writeTo(Me)
                Return Me
            ElseIf val.GetType.Equals(GetType(Dictionary(Of String, Object))) Or val.GetType.Equals(GetType(SortedDictionary(Of String, Object))) Or _
                val.GetType.Equals(GetType(SortedList(Of String, Object))) Or val.GetType.Equals(GetType(Hashtable)) Then
                Dim jsObject As JSONObject = New JSONObject(val)
                jsObject.writeTo(Me)
                Return Me
            ElseIf IsArray(val) Or val.GetType.Equals(GetType(IList(Of Object))) Or val.GetType.Equals(GetType(List(Of Object))) Or _
                val.GetType.Equals(GetType(HashSet(Of Object))) Or val.GetType.Equals(GetType(SortedSet(Of Object))) Or _
                val.GetType.Equals(GetType(ArrayList)) Then
                Dim jsArray As JSONArray = New JSONArray(val)
                jsArray.writeTo(Me)
                Return Me
            End If
            beforeValue()
            If IsNothing(val) Or (val.GetType.Equals(GetType(Boolean))) Then
                out.Append(val)
            ElseIf Numeric(val.GetType) Then
                out.Append(JSONObject.numberToString(val))
            Else
                setString(val.ToString())
            End If
            Return Me
        End Function
        Public Function value(ByVal val As Boolean) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            beforeValue()
            out.Append(val)
            Return Me
        End Function
        Public Function value(ByVal val As Double) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            beforeValue()
            out.Append(val)
            Return Me
        End Function
        Public Function value(ByVal val As Long) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            beforeValue()
            out.Append(val)
            Return Me
        End Function
        Public Function value(ByVal val As Integer) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            beforeValue()
            out.Append(val)
            Return Me
        End Function
        Public Function value(ByVal val As UInteger) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            beforeValue()
            out.Append(val)
            Return Me
        End Function
        Public Function value(ByVal val As Short) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            beforeValue()
            out.Append(val)
            Return Me
        End Function
        Public Function value(ByVal val As UShort) As JSONStringer
            If stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            beforeValue()
            out.Append(val)
            Return Me
        End Function
        ''' <summary>
        ''' 对该字符串的键(属性名)进行编码。
        ''' </summary>
        ''' <param name="name">即将出现的值的名称。不能为空。</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function key(ByVal name As String) As JSONStringer
            If String.IsNullOrEmpty(name) Then
                Throw New Exception("名称必须为非空或长度不能为0")
            End If
            beforeKey()
            setString(name)
            Return Me
        End Function
        ''' <summary>
        ''' 返回编码的JSON字符串。
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overloads Function toString() As String
            If out.Length = 0 Then
                Return Nothing
            Else
                Return out.ToString()
            End If
        End Function
        ''' <summary>
        ''' 通过附加任何必要的空格和给定的括号来输入新的范围。
        ''' </summary>
        ''' <param name="empty"></param>
        ''' <param name="openBracket">用于开始的符号,只能是:{或[</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Friend Function open(ByVal empty As Scope, ByVal openBracket As String) As JSONStringer
            If stack.Count = 0 And out.Length > 0 Then
                Throw New Exception("嵌套问题:多个顶级根")
            End If
            beforeValue()
            stack.Add(empty)
            out.Append(openBracket)
            Return Me
        End Function
        ''' <summary>
        ''' 通过附加任何必要的空白和给定的括号来关闭当前范围。
        ''' </summary>
        ''' <param name="empty"></param>
        ''' <param name="nonempty"></param>
        ''' <param name="closeBracket">用于关闭的符号,必须与<code>open</code>时使用的符号时一对并且只能是:}或]</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Friend Function close(ByVal empty As Scope, ByVal nonempty As Scope, ByVal closeBracket As String) As JSONStringer
            Dim context As Scope = peek()
            If (context <> nonempty) And (context <> empty) Then
                Throw New Exception("嵌套问题")
            End If
            ' stack.Remove(stack.Count - 1)
            stack.RemoveAt(stack.Count - 1)
            If context = empty Then
                newline()
            End If
            out.Append(closeBracket)
            Return Me
        End Function
        ''' <summary>
        ''' 在名称前插入任何必要的分隔符和空格。还调整堆栈以期望键的值。
        ''' </summary>
        ''' <remarks></remarks>
        Friend Sub beforeKey()
            Dim context As Scope = peek()
            If context = Scope.NONEMPTY_OBJECT Then
                out.Append(COMMA)   '添加逗号
            ElseIf context <> Scope.EMPTY_OBJECT Then
                Throw New Exception("嵌套问题")
            End If
            newline()
            replaceTop(Scope.DANGLING_KEY)
        End Sub
        ''' <summary>
        ''' 在文字值、行数组或内联对象之前插入任何必要的分隔符和空格。同时调整堆栈以期望右括号或其他元素。
        ''' </summary>
        ''' <remarks></remarks>
        Friend Sub beforeValue()
            If stack.Count = 0 Then
                Return
            End If
            Dim context As Scope = peek()
            If context = Scope.EMPTY_ARRAY Then '数组中的第一
                replaceTop(Scope.NONEMPTY_ARRAY)
                newline()
            ElseIf context = Scope.NONEMPTY_ARRAY Then '数组中的另一个
                out.Append(COMMA) '添加逗号
                newline()
            ElseIf context = Scope.DANGLING_KEY Then  '键的值
                out.Append(IIf(IsNothing(indent), COLON, COLON_AND_SPACE))
                replaceTop(Scope.NONEMPTY_OBJECT)
            ElseIf context <> Scope.NULL Then
                Throw New Exception("嵌套问题")
            End If
        End Sub
        ''' <summary>
        ''' 返回堆栈顶部的值。
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Friend Function peek() As Scope
            If IsNothing(stack) Then
                Throw New Exception("嵌套问题")
            ElseIf stack.Count = 0 Then
                Throw New Exception("嵌套问题")
            End If
            Return stack.Item(stack.Count - 1)
        End Function
        ''' <summary>
        ''' 用给定值替换堆栈顶部的值。
        ''' </summary>
        ''' <param name="topOfStack"></param>
        ''' <remarks></remarks>
        Friend Sub replaceTop(ByVal topOfStack As Scope)
            stack.Item(stack.Count - 1) = topOfStack
        End Sub
        Friend Sub newline()
            If IsNothing(indent) Then
                Return
            End If
            out.Append(vbLf)   '附加换行符
            For i = 0 To stack.Count - 1
                out.Append(indent)
            Next
        End Sub
        Friend Sub setString(ByVal val As String)
            out.Append(DOUNLE_QUOTATION_MARK)
            For i As Integer = 0 To val.Length - 1
                Dim c As Char = val.Chars(i)
                Select Case c
                    Case DOUNLE_QUOTATION_MARK, "\", "/"  ''\\'
                        out.Append("\").Append(c)
                    Case vbTab  ' '\t'
                        out.Append("\t")
                    Case vbBack   ''\b'
                        out.Append("\b")
                    Case vbLf   ''\n'
                        out.Append("\n")
                    Case vbCr   ''\r'
                        out.Append("\r")
                    Case vbFormFeed ''\f'
                        out.Append("\f")
                    Case Else
                        If Asc(c) <= &H1F Then
                            out.Append(String.Format("\u%04x", Asc(c)))
                        Else
                            out.Append(c)
                        End If
                End Select
            Next
            out.Append(DOUNLE_QUOTATION_MARK)
        End Sub
    
        ''' <summary>
        ''' 类型是数字类型
        ''' </summary>
        ''' <param name="dataType">类型</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private Function Numeric(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
    
    

    JSONArray类。与java JSONArray相同,用于存储json数组

    Public Class JSONArray
        Dim values As ArrayList
        Public Sub New()
            values = New ArrayList()
        End Sub
        ''' <summary>
        ''' 通过Object对象构造实体
        ''' </summary>
        ''' <param name="obj"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal obj As Object)
            If IsArray(obj) Or obj.GetType.Equals(GetType(IList(Of Object))) Or obj.GetType.Equals(GetType(List(Of Object))) Then
                values = ArrayList.Adapter(obj)
            ElseIf obj.GetType.Equals(GetType(HashSet(Of Object))) Or obj.GetType.Equals(GetType(SortedSet(Of Object))) Then
                values = ArrayList.Adapter(obj.ToArray())
            ElseIf obj.GetType.Equals(GetType(ArrayList)) Then
                values = obj
            Else
                values = New ArrayList()
                values.Add(obj)
            End If
        End Sub
        ''' <summary>
        ''' 通过数组列表构造实体
        ''' </summary>
        ''' <param name="arrBuff"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal arrBuff As ArrayList)
            values = arrBuff
        End Sub
        ''' <summary>
        ''' 通过数组构造实体
        ''' </summary>
        ''' <param name="arrBuff"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal arrBuff As Array)
            values = ArrayList.Adapter(arrBuff)
        End Sub
        ''' <summary>
        ''' 通过列表构造实体
        ''' </summary>
        ''' <param name="list"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal list As List(Of Object))
            values = ArrayList.Adapter(list)
        End Sub
        ''' <summary>
        ''' 通过列表构造实体
        ''' </summary>
        ''' <param name="hSet"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal hSet As HashSet(Of Object))
            values = ArrayList.Adapter(hSet.ToArray())
        End Sub
        ''' <summary>
        ''' 通过列表构造实体
        ''' </summary>
        ''' <param name="sSet"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal sSet As SortedSet(Of Object))
            values = ArrayList.Adapter(sSet.ToArray())
        End Sub
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Boolean) As JSONArray
            values.Add(value)
            ' Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Byte) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As SByte) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Char) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Double) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Single) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Short) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As UShort) As JSONArray
            values.Add(value)
            ' Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Integer) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As UInteger) As JSONArray
            values.Add(value)
            ' Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Long) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As ULong) As JSONArray
            values.Add(value)
            ' Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As String) As JSONArray
            values.Add(value)
            'Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal value As Object) As JSONArray
            values.Add(value)
            ' Me.Add(value)
            Return Me
        End Function
        ''' <summary>
        ''' 与<c>put</c>相同,增加了有效性检查。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <remarks></remarks>
        Public Sub CheckedPut(ByVal value As Object)
            If IsNumeric(value) Then
                JSON.checkDouble(value)
            End If
            Put(value)
        End Sub
        Public Function Put(ByVal index As Integer, ByVal value As Object) As JSONArray
            If IsNumeric(value) Then
                JSON.checkDouble(value)
            End If
            While values.Count <= index
                values.Add(Nothing)
            End While
            values.Insert(index, value)
            Return Me
        End Function
        Public Function Put(ByVal index As Integer, ByVal value As Boolean) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As Byte) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As SByte) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As Char) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As Double) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As Single) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As Short) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As UShort) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As Integer) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As UInteger) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As Long) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As ULong) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到此数组的结尾。
        ''' </summary>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Put(ByVal index As Integer, ByVal value As String) As JSONArray
            Dim obj As Object = value
            Return Put(index, obj)
        End Function
        ''' <summary>
        ''' 返回一个 Boolean 值,指示数组指定位置是否未被指派对象。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function IsNothing(ByVal index As Integer) As Boolean
            Dim val As Object = Opt(index)
            Return val = Nothing
        End Function
        Public Function GetItem(ByVal index As Integer) As Object
            Try
                Dim val As Object = values.Item(index)
                If Microsoft.VisualBasic.IsNothing(val) Then
                    Throw New Exception("Value at " + index + " is null.")
                End If
                Return val
            Catch ex As Exception
                Throw New Exception("Index " + index + " out of range [0.." + values.Count() + ")", ex)
            End Try
        End Function
    
        Public Function Opt(ByVal index As Integer) As Object
            If index < 0 Or index >= values.Count Then
                Return Nothing
            End If
            Return values.Item(index)
        End Function
        ''' <summary>
        ''' 删除并返回<code>index</code>处的值,如果数组在<code>index</code>处没有值,则返回nothing。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Remove(ByVal index As Integer) As Object
            Dim val As Object = Opt(index)
            If Microsoft.VisualBasic.IsNothing(val) Then
                Return Nothing
            Else
                'Me.Remove(val)
                values.Remove(val)
                Return val
            End If
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是布尔值或可以强制为布尔值)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为布尔值。</exception>
        Public Function GetBoolean(ByVal index As Integer) As Boolean
            Dim val As Object = GetItem(index)
            Dim result As Boolean = JSON.toBoolean(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Boolean).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是布尔值或可以*强制为布尔值)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptBoolean(ByVal index As Integer, Optional ByVal defaultVal As Boolean = False) As Boolean
            Dim val As Object = Opt(index)
            Dim result As Boolean = JSON.toBoolean(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是Byte或可以强制为Byte)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为Byte。</exception>
        Public Function GetByte(ByVal index As Integer) As Byte
            Dim val As Object = GetItem(index)
            Dim result As Byte = JSON.toByte(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Byte).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是Byte或可以*强制为Byte)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptByte(ByVal index As Integer, Optional ByVal defaultVal As Byte = 0) As Byte
            Dim val As Object = Opt(index)
            Dim result As Byte = JSON.toByte(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是Char或可以强制为Char)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为Char。</exception>
        Public Function GetChar(ByVal index As Integer) As Char
            Dim val As Object = GetItem(index)
            Dim result As Char = JSON.toChar(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Char).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是Char或可以*强制为Char)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptByte(ByVal index As Integer, Optional ByVal defaultVal As Char = Chr(0)) As Char
            Dim val As Object = Opt(index)
            Dim result As Char = JSON.toChar(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是SByte或可以强制为SByte)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为SByte。</exception>
        Public Function GetSByte(ByVal index As Integer) As SByte
            Dim val As Object = GetItem(index)
            Dim result As SByte = JSON.toSByte(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(SByte).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是SByte或可以*强制为SByte)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptSByte(ByVal index As Integer, Optional ByVal defaultVal As SByte = 0) As SByte
            Dim val As Object = Opt(index)
            Dim result As SByte = JSON.toSByte(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是Short或可以强制为Short)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为Short。</exception>
        Public Function GetShort(ByVal index As Integer) As Short
            Dim val As Object = GetItem(index)
            Dim result As Short = JSON.toShort(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Short).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是Short或可以*强制为Short)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptShort(ByVal index As Integer, Optional ByVal defaultVal As Short = 0) As Short
            Dim val As Object = Opt(index)
            Dim result As Short = JSON.toShort(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是UShort或可以强制为UShort)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为UShort。</exception>
        Public Function GetUShort(ByVal index As Integer) As UShort
            Dim val As Object = GetItem(index)
            Dim result As UShort = JSON.toUShort(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(UShort).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是UShort或可以*强制为UShort)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptUShort(ByVal index As Integer, Optional ByVal defaultVal As UShort = 0) As UShort
            Dim val As Object = Opt(index)
            Dim result As UShort = JSON.toUShort(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是Integer或可以强制为Integer)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为Integer。</exception>
        Public Function GetInteger(ByVal index As Integer) As Integer
            Dim val As Object = GetItem(index)
            Dim result As Integer = JSON.toInteger(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Integer).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是Integer或可以*强制为Integer)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptInteger(ByVal index As Integer, Optional ByVal defaultVal As Integer = 0) As Integer
            Dim val As Object = Opt(index)
            Dim result As Integer = JSON.toInteger(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是UInteger或可以强制为UInteger)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为UInteger。</exception>
        Public Function GetUInteger(ByVal index As Integer) As UInteger
            Dim val As Object = GetItem(index)
            Dim result As UInteger = JSON.toUInteger(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(UInteger).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是UInteger或可以*强制为UInteger)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptUInteger(ByVal index As Integer, Optional ByVal defaultVal As UInteger = 0) As UInteger
            Dim val As Object = Opt(index)
            Dim result As UInteger = JSON.toUInteger(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是Long或可以强制为Long)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为Long。</exception>
        Public Function GetLong(ByVal index As Integer) As Long
            Dim val As Object = GetItem(index)
            Dim result As Long = JSON.toLong(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Long).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是Long或可以*强制为Long)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptLong(ByVal index As Integer, Optional ByVal defaultVal As Long = 0) As Long
            Dim val As Object = Opt(index)
            Dim result As Long = JSON.toLong(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是ULong或可以强制为ULong)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为ULong。</exception>
        Public Function GetULong(ByVal index As Integer) As ULong
            Dim val As Object = GetItem(index)
            Dim result As ULong = JSON.toULong(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(ULong).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是ULong或可以*强制为ULong)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptULong(ByVal index As Integer, Optional ByVal defaultVal As ULong = 0) As ULong
            Dim val As Object = Opt(index)
            Dim result As ULong = JSON.toULong(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是Single或可以强制为Single)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为Single。</exception>
        Public Function GetSingle(ByVal index As Integer) As Single
            Dim val As Object = GetItem(index)
            Dim result As Single = JSON.toSingle(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Single).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是Single或可以*强制为Single)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptSingle(ByVal index As Integer, Optional ByVal defaultVal As Single = 0.0) As Single
            Dim val As Object = Opt(index)
            Dim result As Single = JSON.toSingle(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是Double或可以强制为Double)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为Double。</exception>
        Public Function GetDouble(ByVal index As Integer) As Double
            Dim val As Object = GetItem(index)
            Dim result As Double = JSON.toDouble(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(Double).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是Double或可以*强制为Double)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptDouble(ByVal index As Integer, Optional ByVal defaultVal As Double = 0.0) As Double
            Dim val As Object = Opt(index)
            Dim result As Double = JSON.toDouble(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
    
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果它存在且是String或可以强制为String)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        ''' <exception cref="Exception">如果<code>index</code>处的值不存在或无法强制为String。</exception>
        Public Function GetString(ByVal index As Integer) As String
            Dim val As Object = GetItem(index)
            Dim result As String = JSON.ToString(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(index, val, GetType(String).Name)
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是String或可以*强制为String)。否则返回<code>defaultVal</code>。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptString(ByVal index As Integer, Optional ByVal defaultVal As String = Nothing) As String
            Dim val As Object = Opt(index)
            Dim result As String = JSON.ToString(val)
            Return IIf(Microsoft.VisualBasic.IsNothing(result), defaultVal, result)
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是或可以强制为<code>JSONArray</code>)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function GetJSONArray(ByVal index As Integer) As JSONArray
            Dim val As Object = GetItem(index)
            If val.GetType.Equals(GetType(JSONArray)) Then
                Return val
            ElseIf IsArray(val) Or val.GetType.Equals(GetType(ArrayList)) Or val.GetType.Equals(GetType(IList(Of Object))) Or val.GetType.Equals(GetType(List(Of Object))) Then
                Return New JSONArray(val)
            Else
                Throw JSON.typeMismatch(index, val, "JSONArray")
            End If
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是或可以强制为<code>JSONArray</code>)。否则返回Nothing。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptJSONArray(ByVal index As Integer) As JSONArray
            Dim val As Object = Opt(index)
            If val.GetType.Equals(GetType(JSONArray)) Then
                Return val
            ElseIf IsArray(val) Or val.GetType.Equals(GetType(ArrayList)) Or val.GetType.Equals(GetType(IList(Of Object))) Or val.GetType.Equals(GetType(List(Of Object))) Then
                Return New JSONArray(val)
            Else
                Return Nothing
            End If
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是或者强制转换为<code>JSONObject</code>)。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function GetJSONObject(ByVal index As Integer) As JSONObject
            Dim val As Object = GetItem(index)
            If val.GetType.Equals(GetType(JSONObject)) Then
                Return val
            ElseIf val.GetType.Equals(GetType(Dictionary(Of String, Object))) Then
                Dim d As Dictionary(Of String, Object) = val
                Return New JSONObject(d)
            ElseIf val.GetType.Equals(GetType(SortedDictionary(Of String, Object))) Then
                Dim sd As SortedDictionary(Of String, Object) = val
                Dim d As Dictionary(Of String, Object) = New Dictionary(Of String, Object)
                For Each kvp As KeyValuePair(Of String, Object) In sd   '遍历元素
                    d.Add(kvp.Key, kvp.Value)
                Next
                Return New JSONObject(d)
            ElseIf val.GetType.Equals(GetType(String)) Then
                Return New JSONObject(CStr(val))
            Else
                Throw JSON.typeMismatch(index, val, "JSONObject")
            End If
        End Function
        ''' <summary>
        ''' 返回<code>index</code>处的值(如果该值存在并且是或可以强制为<code>JSONObject</code>)。否则返回Nothing。
        ''' </summary>
        ''' <param name="index"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function OptJSONObject(ByVal index As Integer) As JSONObject
            Dim val As Object = GetItem(index)
            Try
                If val.GetType.Equals(GetType(JSONObject)) Then
                    Return val
                ElseIf val.GetType.Equals(GetType(Dictionary(Of String, Object))) Then
                    Dim d As Dictionary(Of String, Object) = val
                    Return New JSONObject(d)
                ElseIf val.GetType.Equals(GetType(SortedDictionary(Of String, Object))) Then
                    Dim sd As SortedDictionary(Of String, Object) = val
                    Dim d As Dictionary(Of String, Object) = New Dictionary(Of String, Object)
                    For Each kvp As KeyValuePair(Of String, Object) In sd   '遍历元素
                        d.Add(kvp.Key, kvp.Value)
                    Next
                    Return New JSONObject(d)
                ElseIf val.GetType.Equals(GetType(String)) Then
                    Return New JSONObject(CStr(val))
                Else
                    Return Nothing
                End If
            Catch ex As Exception
                Return Nothing
            End Try
        End Function
        ''' <summary>
        ''' 返回一个新对象,其值是此数组中的值,其名称是<code>names</code>中的值。名称和值按索引从0到较短数组长度配对。不是字符串的名称将强制为字符串。如果任一数组为空,则此方法返回Nothing。
        ''' </summary>
        ''' <param name="names"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function toJSONObject(ByVal names As JSONArray) As JSONObject
            Dim result As JSONObject = New JSONObject()
            Dim length As Integer = Math.Min(names.Count, values.Count)
            If length = 0 Then
                Return Nothing
            End If
            For i = 0 To length - 1
                Dim name As String = JSON.ToString(names.Opt(i))
                result.put(name, Opt(i))
            Next
            Return result
        End Function
        ''' <summary>
        ''' 通过将此数组的值与<code>separator</code>交替返回新字符串。此数组的字符串值被引用,并对其特殊字符进行转义。例如,包含字符串'12" pizza', 'taco' 和 'soda' 的数组在'+'上连接返回:
        ''' "12\" pizza"+"taco"+"soda"
        ''' </summary>
        ''' <param name="separator"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Join(ByVal separator As String) As String
            Dim stringer As JSONStringer = New JSONStringer()
            stringer.open(JSONStringer.Scope.NULL, "")
            For i As Integer = 0 To values.Count - 1
                If i > 0 Then
                    stringer.out.Append(separator)
                End If
                stringer.value(values.Item(i))
            Next
            stringer.close(JSONStringer.Scope.NULL, JSONStringer.Scope.NULL, "")
            Return stringer.out.ToString()
        End Function
        ''' <summary>
        ''' 将此数组编码为紧凑的JSON字符串,例如:[94043,90210]
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overrides Function toString() As String
            Try
                Dim stringer As JSONStringer = New JSONStringer()
                writeTo(stringer)
                Return stringer.toString()
            Catch ex As Exception
                Return Nothing
            End Try
        End Function
        ''' <summary>
        ''' 将此数组编码为用于调试的可读JSON字符串,例如:[94043, 90210]
        ''' </summary>
        ''' <param name="indentSpaces">嵌套的每个级别缩进的空格数。</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overloads Function toString(ByVal indentSpaces As Integer) As String
            Dim stringer As JSONStringer = New JSONStringer(indentSpaces)
            writeTo(stringer)
            Return stringer.toString()
        End Function
        Friend Sub writeTo(stringer As JSONStringer)
            stringer.startArray()
            For Each val As Object In values
                stringer.value(val)
            Next
            stringer.endArray()
        End Sub
        Public Overloads Function Equals(ByVal obj As Object) As Boolean
            If obj.GetType.Equals(GetType(JSONArray)) Then
                Return obj.values.Equals(values)
            End If
    
            Return False
        End Function
        Public Overloads Function GetHashCode() As Integer
            Return values.GetHashCode()
        End Function
        ''' <summary>
        ''' 类型是数字类型
        ''' </summary>
        ''' <param name="dataType">类型</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Private 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
    
        ''' <summary>
        ''' 返回此数组中的值数。
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property Count() As Integer ' Implements ICollection(Of Object).Count
            Get
                Return values.Count
            End Get
        End Property
        Public Sub Clear()
            values.Clear()
        End Sub
        Public Sub CopyTo(array As Object(), arrayIndex As Integer)
            If array Is Nothing Then
                Throw New ArgumentNullException("The array cannot be null.")
            ElseIf arrayIndex < 0 Then
                Throw New ArgumentOutOfRangeException("The starting array index cannot be negative.")
            ElseIf Count > array.Length - arrayIndex + 1 Then
                Throw New ArgumentException("The destination array has fewer elements than the collection.")
            End If
            ' For i As Integer = 0 To listArray.Length - 1
            'array(i + arrayIndex) = listArray(i)
            ' Next
            values.CopyTo(array, arrayIndex)
        End Sub
    
    End Class
    
    

    JSONObject类。与java JSONObject相同。json的主类,用于接收json字符串和输出json字符串

    Imports System.Web.Script.Serialization
    
    Public Class JSONObject
        Const NEGATIVE_ZERO = -0D
        Dim nameValuePairs As Dictionary(Of String, Object)
        Public Sub New()
            nameValuePairs = New Dictionary(Of String, Object)
        End Sub
        Public Sub New(ByVal d As Dictionary(Of String, Object))
            nameValuePairs = d
        End Sub
        Public Sub New(ByVal sd As SortedDictionary(Of String, Object))
            nameValuePairs = New Dictionary(Of String, Object)
            For Each kvp As KeyValuePair(Of String, Object) In sd   '遍历元素
                nameValuePairs.Add(kvp.Key, kvp.Value)
            Next
        End Sub
        Public Sub New(ByVal sl As SortedList(Of String, Object))
            nameValuePairs = New Dictionary(Of String, Object)
            For Each kvp As KeyValuePair(Of String, Object) In sl   '遍历元素
                nameValuePairs.Add(kvp.Key, kvp.Value)
            Next
        End Sub
        Public Sub New(ByVal hash As Hashtable)
            nameValuePairs = New Dictionary(Of String, Object)
            For Each de As DictionaryEntry In hash
                nameValuePairs.Add(de.Key, de.Value)
            Next
        End Sub
        Public Sub New(ByVal o As Object)
            If o.GetType.Equals(GetType(Dictionary(Of String, Object))) Then
                nameValuePairs = o
            ElseIf o.GetType.Equals(GetType(SortedDictionary(Of String, Object))) Then
                Dim sd As SortedDictionary(Of String, Object) = o
                nameValuePairs = New Dictionary(Of String, Object)
                For Each kvp As KeyValuePair(Of String, Object) In sd   '遍历元素
                    nameValuePairs.Add(kvp.Key, kvp.Value)
                Next
            ElseIf o.GetType.Equals(GetType(SortedList(Of String, Object))) Then
                Dim sl As SortedList(Of String, Object) = o
                For Each kvp As KeyValuePair(Of String, Object) In sl   '遍历元素
                    nameValuePairs.Add(kvp.Key, kvp.Value)
                Next
            ElseIf o.GetType.Equals(GetType(Hashtable)) Then
                Dim hash As Hashtable = o
                nameValuePairs = New Dictionary(Of String, Object)
                For Each de As DictionaryEntry In hash
                    nameValuePairs.Add(de.Key, de.Value)
                Next
            End If
        End Sub
        ''' <summary>
        ''' 使用标记器中下一个对象的名称/值映射创建一个新的<code>JSONTokener</code>。
        ''' </summary>
        ''' <param name="readFrom"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal readFrom As JSONTokener)
            Dim obj As Object = readFrom.NextValue()
            If obj.GetType.Equals(GetType(JSONObject)) Then
                nameValuePairs = obj
            Else
                Throw JSON.typeMismatch(obj, "JSONObject")
            End If
        End Sub
        ''' <summary>
        ''' 使用JSON字符串中的名称/值映射创建一个新的<code>JSONTokener</code>。
        ''' </summary>
        ''' <param name="js"></param>
        ''' <remarks></remarks>
        Public Sub New(ByVal js As String)
            Try
                Dim readFrom As JSONTokener = New JSONTokener(js)
                Dim obj As Object = readFrom.NextValue()
                If obj.GetType.Equals(GetType(JSONObject)) Then
                    nameValuePairs = obj
                Else
                    Throw JSON.typeMismatch(obj, "JSONObject")
                End If
            Catch ex As Exception
                nameValuePairs = New JavaScriptSerializer().DeserializeObject(js)
            End Try
        End Sub
        ''' <summary>
        ''' 通过从给定对象复制列出的名称的映射,创建一个新的<code>JSONObject</code>。将跳过<code>copyFrom</code>中不存在的名称。
        ''' </summary>
        ''' <param name="copyFrom">要复制的JSONObject对象</param>
        ''' <param name="names">新的名称</param>
        ''' <remarks></remarks>
        Public Sub New(ByVal copyFrom As JSONObject, ByVal names() As String)
            Me.New()
            For Each name As String In names
                Dim val As Object = copyFrom.opt(name)
                If Not Microsoft.VisualBasic.IsNothing(val) Then
                    nameValuePairs.Add(name, val)
                End If
            Next
        End Sub
        ' ''' <summary>
        ' ''' 返回此对象中名称/值映射的数目。
        ' ''' </summary>
        ' ''' <returns></returns>
        ' ''' <remarks></remarks>
        'Public Function length() As Integer
        '    Return nameValuePairs.Count()
        'End Function
    
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Boolean) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    ' Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Byte) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    ' Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Char) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    ' Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Double) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    ' Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Integer) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As UInteger) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    ' Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Long) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name).Values(= value
                Else
                    nameValuePairs.Add(name, value)
                    ' Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As ULong) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    ' Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Short) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As UShort) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Single) As JSONObject
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    'Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 将指定值与此映射中的指定键相关联。如果映射以前包含键的映射,则替换旧值。
        ''' </summary>
        ''' <param name="name">与指定值关联的键</param>
        ''' <param name="value">要与指定键关联的值</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function put(ByVal name As String, ByVal value As Object) As JSONObject
            If value Is Nothing Then
                ' nameValuePairs.Remove(name)
                Return Me.Remove(name)
                'Return Me
            End If
            If checkName(name) Then
                If nameValuePairs.ContainsKey(name) Then
                    nameValuePairs.Item(name) = value
                    ' Me.Item(name) = value
                Else
                    nameValuePairs.Add(name, value)
                    'Me.Add(name, value)
                End If
                Return Me
            Else
                Return Me
            End If
        End Function
        ''' <summary>
        ''' 当两个参数都为非null时,等效于<code> put(name,value)</code>;否则不执行任何操作。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function putOpt(ByVal name As String, ByVal value As Object) As JSONObject
            If Microsoft.VisualBasic.IsNothing(name) Or Microsoft.VisualBasic.IsNothing(value) Then
                Return Me
            Else
                If name.Length = 0 Then
                    Return Me
                End If
            End If
            Return put(name, value)
        End Function
        ''' <summary>
        ''' 将<code>value</code>追加到已映射到<code>name</code>的数组。
        ''' 如果此对象没有<code>name</code>的映射,则会插入一个新映射。
        ''' 如果映射存在,但其值不是数组,则按顺序将现有值和新值插入一个新数组,该数组本身映射到<code>name</code>。
        ''' 总的来说,这允许一次向一个映射添加一个值。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Accumulate(ByVal name As String, ByVal value As Object) As JSONObject
            Dim current As Object = nameValuePairs.Item(checkName(name))
            If Microsoft.VisualBasic.IsNothing(current) Then
                Return put(name, value)
            End If
            If current.GetType.Equals(GetType(JSONArray)) Then
                Dim array As JSONArray = current
                array.CheckedPut(value)
            Else
                Dim array As JSONArray = New JSONArray()
                array.CheckedPut(current)
                array.CheckedPut(value)
                nameValuePairs.Add(name, array)
            End If
            Return Me
        End Function
        ''' <summary>
        ''' 将值附加到映射到<code>name</code>的数组。如果不存在映射,<code>name</code>的新<code>JSONArray</code>映射将被插入。
        ''' 如果<code>name</code>的现有映射不是<code>JSONArray</code>,则将抛出<code>Exception</code> 。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="value"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Append(ByVal name As String, ByVal value As Object) As JSONObject
            Dim current As Object = nameValuePairs.Item(checkName(name))
            Dim array As JSONArray
            If current Is Nothing Then
                Dim newArray As JSONArray = New JSONArray()
                nameValuePairs.Add(name, newArray)
                array = newArray
            ElseIf current.GetType.Equals(GetType(JSONArray)) Then
                array = current
            Else
                Throw New Exception("Key " + name + " is not a JSONArray")
            End If
            array.CheckedPut(value)
            Return Me
        End Function
        ''' <summary>
        ''' 如果存在,则移除命名映射;否则不执行任何操作。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Remove(ByVal name As String) As Object
            Dim val As Object = nameValuePairs.Item(name)
            nameValuePairs.Remove(name)
            Return val
        End Function
        ''' <summary>
        ''' 如果此对象没有{@code name}的映射或其值为{@link#NULL}的映射,则返回true。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function IsNothing(ByVal name As String) As Boolean
            Dim value As Object = nameValuePairs(name)
            Return IIf(Microsoft.VisualBasic.IsNothing(value), True, False)
        End Function
        ''' <summary>
        ''' 如果此对象具有{@code name}的映射,则返回true。映射可能是{@link#NULL}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function has(ByVal name As String) As Boolean
            Return nameValuePairs.ContainsKey(name)
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值,如果不存在这样的映射,则抛出。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getItem(name As String) As Object
            Dim result As Object = nameValuePairs.Item(name)
            If result Is Nothing Then
                Throw New Exception("No value for " + name)
            End If
            Return result
        End Function
        ' Public Shared Function numberToString()
        ''' <summary>
        ''' 返回由{@code name}映射的值,如果不存在此类映射,则返回nothing。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function opt(name As String) As Object
            Return nameValuePairs.Item(name)
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值,或者可以强制为布尔值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getBoolean(ByVal name As String) As Boolean
            Dim val As Object = getItem(name)
            Dim result As Boolean = JSON.toBoolean(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "boolean")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为布尔值),否则返回{@code fallback}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optBoolean(ByVal name As String, Optional ByVal defaultVal As Boolean = False) As Boolean
            Dim val As Object = getItem(name)
            Dim result As Boolean = JSON.toBoolean(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是Byte值,或者可以强制为Byte值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getByte(ByVal name As String) As Byte
            Dim val As Object = getItem(name)
            Dim result As Byte = JSON.toByte(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "Byte")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为Byte值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optByte(ByVal name As String, Optional ByVal defaultVal As Byte = 0) As Byte
            Dim val As Object = getItem(name)
            Dim result As Byte = JSON.toByte(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是SByte值,或者可以强制为SByte值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getSByte(ByVal name As String) As SByte
            Dim val As Object = getItem(name)
            Dim result As SByte = JSON.toSByte(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "SByte")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为SByte值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optSByte(ByVal name As String, Optional ByVal defaultVal As SByte = 0) As SByte
            Dim val As Object = getItem(name)
            Dim result As SByte = JSON.toSByte(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是Short值,或者可以强制为Short值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getShort(ByVal name As String) As Short
            Dim val As Object = getItem(name)
            Dim result As Short = JSON.toShort(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "Short")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为Short值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optShort(ByVal name As String, Optional ByVal defaultVal As Short = 0) As Short
            Dim val As Object = getItem(name)
            Dim result As Short = JSON.toShort(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是UShort值,或者可以强制为UShort值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getUShort(ByVal name As String) As UShort
            Dim val As Object = getItem(name)
            Dim result As UShort = JSON.toUShort(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "UShort")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为UShort值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optUShort(ByVal name As String, Optional ByVal defaultVal As UShort = 0) As UShort
            Dim val As Object = getItem(name)
            Dim result As UShort = JSON.toUShort(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是Char值,或者可以强制为Char值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getChar(ByVal name As String) As Char
            Dim val As Object = getItem(name)
            Dim result As Char = JSON.toChar(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "Char")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为Char值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optChar(ByVal name As String, Optional ByVal defaultVal As Char = Chr(0)) As Char
            Dim val As Object = getItem(name)
            Dim result As Char = JSON.toChar(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是Integer值,或者可以强制为Integer值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getInteger(ByVal name As String) As Integer
            Dim val As Object = getItem(name)
            Dim result As Integer = JSON.toInteger(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "UShort")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为Integer值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optInteger(ByVal name As String, Optional ByVal defaultVal As Integer = 0) As Integer
            Dim val As Object = getItem(name)
            Dim result As Integer = JSON.toInteger(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是UInteger值,或者可以强制为UInteger值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getUInteger(ByVal name As String) As UInteger
            Dim val As Object = getItem(name)
            Dim result As UInteger = JSON.toUInteger(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "UInteger")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为UInteger值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optUInteger(ByVal name As String, Optional ByVal defaultVal As UInteger = 0) As UInteger
            Dim val As Object = getItem(name)
            Dim result As UInteger = JSON.toUInteger(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是Long值,或者可以强制为Long值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getLong(ByVal name As String) As Long
            Dim val As Object = getItem(name)
            Dim result As Long = JSON.toLong(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "Long")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为Long值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optLong(ByVal name As String, Optional ByVal defaultVal As Long = 0) As Long
            Dim val As Object = getItem(name)
            Dim result As Long = JSON.toLong(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是ULong值,或者可以强制为ULong值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getULong(ByVal name As String) As ULong
            Dim val As Object = getItem(name)
            Dim result As ULong = JSON.toULong(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "ULong")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为ULong值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optULong(ByVal name As String, Optional ByVal defaultVal As ULong = 0) As ULong
            Dim val As Object = getItem(name)
            Dim result As ULong = JSON.toULong(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是Single值,或者可以强制为Single值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getSingle(ByVal name As String) As Single
            Dim val As Object = getItem(name)
            Dim result As Single = JSON.toSingle(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "Single")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为Single值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optSingle(ByVal name As String, Optional ByVal defaultVal As Single = 0) As Single
            Dim val As Object = getItem(name)
            Dim result As Single = JSON.toSingle(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是Double值,或者可以强制为Double值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getDouble(ByVal name As String) As Double
            Dim val As Object = getItem(name)
            Dim result As Double = JSON.toDouble(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "Double")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为Double值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optDouble(ByVal name As String, Optional ByVal defaultVal As Double = 0) As Double
            Dim val As Object = getItem(name)
            Dim result As Double = JSON.toDouble(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
    
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是String值,或者可以强制为String值,或者抛出其他值)。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getString(ByVal name As String) As String
            Dim val As Object = getItem(name)
            Dim result As String = JSON.ToString(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Throw JSON.typeMismatch(name, val, "String")
            End If
            Return result
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是布尔值或可以强制为String值),否则返回{@code defaultVal}。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <param name="defaultVal"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optString(ByVal name As String, Optional ByVal defaultVal As String = Nothing) As String
            Dim val As Object = getItem(name)
            Dim result As String = JSON.ToString(val)
            If Microsoft.VisualBasic.IsNothing(result) Then
                Return defaultVal
            Else
                Return val
            End If
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果它存在并且是{@code JSONArray}),否则抛出。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getJSONArray(ByVal name As String) As JSONArray
            Dim val As Object = getItem(name)
            If val.GetType.Equals(GetType(JSONArray)) Then
                Return val
            ElseIf IsArray(val) Or val.GetType.Equals(GetType(ArrayList)) Or val.GetType.Equals(GetType(IList(Of Object))) Or val.GetType.Equals(GetType(List(Of Object))) Then
                Return New JSONArray(val)
            Else
                Throw JSON.typeMismatch(name, val, "JSONArray")
            End If
    
        End Function
        ''' <summary>
        ''' 返回由{@code name}映射的值(如果该值存在并且是{@code JSONArray}),否则返回nothing。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optJSONArray(ByVal name As String) As JSONArray
            Dim val As Object = getItem(name)
            If val.GetType.Equals(GetType(JSONArray)) Then
                Return val
            ElseIf IsArray(val) Or val.GetType.Equals(GetType(ArrayList)) Or val.GetType.Equals(GetType(IList(Of Object))) Or val.GetType.Equals(GetType(List(Of Object))) Then
                Return New JSONArray(val)
            Else
                Return Nothing
            End If
        End Function
        ''' <summary>
        ''' 返回由{@code name}处的值(如果该值存在并且是或者强制转换为<code>JSONObject</code>),否则抛出。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function getJSONObject(ByVal name As String) As JSONObject
            Dim val As Object = getItem(name)
            If val.GetType.Equals(GetType(JSONObject)) Then
                Return val
            ElseIf val.GetType.Equals(GetType(Dictionary(Of String, Object))) Then
                Dim d As Dictionary(Of String, Object) = val
                Return New JSONObject(d)
            ElseIf val.GetType.Equals(GetType(SortedDictionary(Of String, Object))) Then
                Dim sd As SortedDictionary(Of String, Object) = val
                Dim d As Dictionary(Of String, Object) = New Dictionary(Of String, Object)
                For Each kvp As KeyValuePair(Of String, Object) In sd   '遍历元素
                    d.Add(kvp.Key, kvp.Value)
                Next
                Return New JSONObject(d)
            ElseIf val.GetType.Equals(GetType(String)) Then
                Return New JSONObject(CStr(val))
            Else
                Throw JSON.typeMismatch(name, val, "JSONObject")
            End If
        End Function
    
        ''' <summary>
        ''' 返回<code>name</code>处的值(如果该值存在并且是或可以强制为<code>JSONObject</code>)。否则返回Nothing。
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function optJSONObject(ByVal name As String) As JSONObject
            Dim val As Object = getItem(name)
            Try
                If val.GetType.Equals(GetType(JSONObject)) Then
                    Return val
                ElseIf val.GetType.Equals(GetType(Dictionary(Of String, Object))) Then
                    Dim d As Dictionary(Of String, Object) = val
                    Return New JSONObject(d)
                ElseIf val.GetType.Equals(GetType(SortedDictionary(Of String, Object))) Then
                    Dim sd As SortedDictionary(Of String, Object) = val
                    Dim d As Dictionary(Of String, Object) = New Dictionary(Of String, Object)
                    For Each kvp As KeyValuePair(Of String, Object) In sd   '遍历元素
                        d.Add(kvp.Key, kvp.Value)
                    Next
                    Return New JSONObject(d)
                ElseIf val.GetType.Equals(GetType(String)) Then
                    Return New JSONObject(CStr(val))
                Else
                    Return Nothing
                End If
            Catch ex As Exception
                Return Nothing
            End Try
        End Function
        ''' <summary>
        ''' 返回值与{@code names}对应的数组。对于未映射的名称,数组包含null。如果{@code names}为null或空,则此方法返回null。
        ''' </summary>
        ''' <param name="names"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function toJSONArray(ByVal names As JSONArray) As JSONArray
            Dim result As JSONArray = New JSONArray()
            If names Is Nothing Then
                Return Nothing
            End If
            If names.Count = 0 Then
                Return Nothing
            End If
            For i As Integer = 0 To names.Count - 1
                Dim name As String = JSON.ToString(names.Opt(i))
                result.Put(opt(name))
            Next
            Return result
        End Function
        ''' <summary>
        ''' 将此对象编码为压缩JSON字符串,例如:
        ''' {"query":"Pizza","locations":[94043,90210]}
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overloads Function toString() As String
            Try
                Dim stringer As JSONStringer = New JSONStringer()
                writeTo(stringer)
                Return stringer.toString()
            Catch ex As Exception
                Return Nothing
            End Try
        End Function
        ''' <summary>
        ''' 将此数组编码为用于调试的可读JSON字符串,例如:[94043, 90210]
        ''' </summary>
        ''' <param name="indentSpaces">嵌套的每个级别缩进的空格数。</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overloads Function toString(ByVal indentSpaces As Integer) As String
            Dim stringer As JSONStringer = New JSONStringer(indentSpaces)
            writeTo(stringer)
            Return stringer.toString()
        End Function
        ''' <summary>
        ''' 检测键名是否有效
        ''' </summary>
        ''' <param name="name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Friend Function checkName(ByVal name As String) As Boolean
            Dim isNotNull As Boolean = False
            If Not Microsoft.VisualBasic.IsNothing(name) Then
                If name.Length > 0 Then
                    isNotNull = True
                End If
            End If
            Return isNotNull
        End Function
        Friend Sub writeTo(stringer As JSONStringer)
            stringer.startObject()
            For Each entry In nameValuePairs
                stringer.key(entry.Key).value(entry.Value)
            Next
            stringer.endObject()
        End Sub
        ''' <summary>
        ''' 将数字编码为JSON字符串。
        ''' </summary>
        ''' <param name="number"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Shared Function numberToString(ByVal number As Object) As String
            If number Is Nothing Then
                Throw New Exception("Number must be non-null")
            End If
            Dim doubleValue As Double = CDbl(number)
            If number.Equals(NEGATIVE_ZERO) Then
                Return "-0"
            End If
            Dim longValue As Long = CLng(number)
            If doubleValue = CDbl(longValue) Then
                Return longValue.ToString
            End If
            Return number.ToString()
        End Function
        ''' <summary>
        ''' 将{@code data}编码为JSON字符串。这将应用引号和任何必要的字符转义。
        ''' </summary>
        ''' <param name="data">要编码的字符串。Nothing将被解释为空</param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Shared Function quote(ByVal data As String) As String
            If data Is Nothing Then
                Return """"""   '返回两个双引号
            End If
            Try
                Dim stringer As JSONStringer = New JSONStringer()
                stringer.open(JSONStringer.Scope.NULL, "")
                stringer.value(data)
                stringer.close(JSONStringer.Scope.NULL, JSONStringer.Scope.NULL, "")
                Return stringer.toString()
            Catch ex As Exception
                Throw New Exception(ex.Message)
            End Try
        End Function
        ''' <summary>
        ''' 如有必要,包装给定对象。
        ''' 如果对象是<code>JSONArray</code>或<code>JSONObject</code>,则不需要包装。
        ''' 如果对象是<code>Array</code>、<code>ArrayList</code>或<code>List(Of Object)</code>,则返回等效的<code>JSONArray</code>。
        ''' 如果对象是原始包装类型或<code>String</code>,则返回对象。
        ''' </summary>
        ''' <param name="o"></param>
        ''' <returns>如果包装失败,则返回Nothing。</returns>
        ''' <remarks></remarks>
        Public Shared Function wrap(ByVal o As Object) As Object
            If o Is Nothing Then
                Return "null"
            End If
            If o.GetType.Equals(GetType(JSONArray)) Or o.GetType.Equals(GetType(JSONObject)) Then
                Return o
            End If
            Try
                If o.GetType.Equals(GetType(ArrayList)) Then
                    Dim aList As ArrayList = o
                    Return New JSONArray(aList)
                ElseIf o.GetType.Equals(GetType(Array)) Then
                    Dim a As Array = o
                    Return New JSONArray(a)
                ElseIf o.GetType.Equals(GetType(List(Of Object))) Then
                    Dim l As List(Of Object) = o
                    Return New JSONArray(l)
                ElseIf o.GetType.Equals(GetType(HashSet(Of Object))) Then
                    Dim l As HashSet(Of Object) = o
                    Return New JSONArray(l)
                ElseIf o.GetType.Equals(GetType(SortedSet(Of Object))) Then
                    Dim l As SortedSet(Of Object) = o
                    Return New JSONArray(l)
                ElseIf o.GetType.Equals(GetType(Boolean)) Or o.GetType.Equals(GetType(Byte)) Or _
                    o.GetType.Equals(GetType(SByte)) Or o.GetType.Equals(GetType(Short)) Or _
                    o.GetType.Equals(GetType(UShort)) Or o.GetType.Equals(GetType(Integer)) Or _
                    o.GetType.Equals(GetType(UInteger)) Or o.GetType.Equals(GetType(Long)) Or _
                    o.GetType.Equals(GetType(ULong)) Or o.GetType.Equals(GetType(Single)) Or _
                    o.GetType.Equals(GetType(Double)) Or o.GetType.Equals(GetType(Char)) Or _
                     o.GetType.Equals(GetType(String)) Then
                    Return o
                End If
            Catch ex As Exception
            End Try
            Return Nothing
        End Function
        ''''''''''''''''''''''''''''''''''''接口实现属性及方法''''''''''''''''''''''''''''''''''''''''
        '''''''''''''''属性'''''''''''''''''''
        ''' <summary>
        ''' 返回列表长度
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property Count() As Integer
            Get
                Return nameValuePairs.Count
            End Get
        End Property
        ''' <summary>
        ''' 返回包含此对象中的字符串名称的数组。
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property NamesAt() As Dictionary(Of String, Object).KeyCollection
            Get
                Return nameValuePairs.Keys()
            End Get
        End Property
        ''' <summary>
        ''' 返回包含此对象中的字符串名称的数组。如果此对象不包含映射,则此方法返回Nothing。
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public ReadOnly Property Names() As JSONArray
            Get
                If nameValuePairs Is Nothing Then
                    Return Nothing
                Else
                    Dim arr As Array = nameValuePairs.Keys().ToArray
                    Return New JSONArray(arr)
                End If
            End Get
        End Property
        Public ReadOnly Property IsReadOnly As Boolean
            Get
                Return False
            End Get
        End Property
        Public ReadOnly Property Values As ICollection(Of Object)
            Get
                Return nameValuePairs.Values
            End Get
        End Property
        Public Function Contains(ByVal k As KeyValuePair(Of String, Object)) As Boolean
            Return nameValuePairs.Contains(k)
        End Function
        Public Sub Clear()
            nameValuePairs.Clear()
        End Sub
        Public Sub CopyTo(array() As KeyValuePair(Of String, Object), arrayIndex As Integer)
            If array Is Nothing Then
                Throw New ArgumentNullException("The array cannot be null.")
            ElseIf arrayIndex < 0 Then
                Throw New ArgumentOutOfRangeException("The starting array index cannot be negative.")
            ElseIf Count > array.Length - arrayIndex + 1 Then
                Throw New ArgumentException("The destination array has fewer elements than the collection.")
            End If
    
            Dim keyList As List(Of KeyValuePair(Of String, Object)) = nameValuePairs.ToList
            For i As Integer = 0 To nameValuePairs.Count - 1
                ' Dim key As String = nameValuePairs.
                array(i + arrayIndex) = keyList.Item(i)
            Next
        End Sub
    End Class
    
    

    其中的Public Sub New(ByVal js As String)中使用了一个第三方类JavaScriptSerializer,主要是防止自己写的解析类出而做的备选,其实是可以不用的,代码如下:

        Public Sub New(ByVal js As String)
            Try
                Dim readFrom As JSONTokener = New JSONTokener(js)
                Dim obj As Object = readFrom.NextValue()
                If obj.GetType.Equals(GetType(JSONObject)) Then
                    nameValuePairs = obj
                Else
                    Throw JSON.typeMismatch(obj, "JSONObject")
                End If
            Catch ex As Exception
                nameValuePairs = New JavaScriptSerializer().DeserializeObject(js)
            End Try
        End Sub
    

    测试代码如下:

    Private Sub test()
    Dim s As String = "{""UserName"":""admin"",""Pwd"":{""as"":""df"",""va"":""gh""},""ID"":1234,""Array"":[{""a"":""dc"",""b"":""ca""},{""a"":""gf"",""b"":""ta""}]}"
    dim jsonObj as JSONObject=new JSONObject(s)
    end sub
    
    展开全文
  • VB利用官方api读写JSON数据格式文件简单实例,是一个非常、非常简单的例子…………
  • vb6读写json格式文件,这里是源码,可以直接拿来使用。
  • vb.net】json文件的读写

    千次阅读 2018-02-04 13:03:17
    由于vb实在缺例子,学习正经的json读写方法有点花时间,而且我也不是专业写程序的,所以秉着“速度要紧,能用就好”宗旨,决定自写json的解析。 ======正文===== 对于json文件的解析,我的思路是: 1.字符串去...

    这里提供的方式只是个人的摸索,肯定不是正常的方法。由于vb实在缺例子,学习正经的json读写方法有点花时间,而且我也不是专业写程序的,所以秉着“速度要紧,能用就好”宗旨,决定自写json的解析。

    ======正文=====

    对于json文件的解析,我的思路是:

    1.字符串去格式化,将无意义的字符去掉(空格、换行等)

    2.将字符串对象化,生成为三个数组(因为对类模块使用不熟练,所以用了一个非常土的方法),第一个是Key的名字集合,第二个是数值的集合,第三个是数值类型的集合。

    3.能将对象化后的数据,进行修改/添加/删除的操作。

    4.将json对象转换为json字符串。

    5.将json字符串格式化,转换为便于阅读的格式。

    =====数组函数============

     Class Arr
            Function Cut(ArrayObject, Index) '将指定位置的元素cong
                Dim ArrCount, OArr(), i, ci
                ArrCount = UBound(ArrayObject)
                If ArrCount = 0 Then
                    Cut = Reset()
                    Exit Function
                End If
                ReDim OArr(ArrCount - 1)
                ci = 0
                For i = 0 To ArrCount
                    If Index <> i Then
                        OArr(ci) = ArrayObject(i)
                        ci = ci + 1
                    End If
                Next
                Cut = OArr
            End Function
            Function Reset()  '将变量初始化为数组
                Dim arr(0)
                arr(0) = "***Arr*initial***"
                Reset = arr
            End Function
            Function Add(ArrayObject, item)
                Dim ArrCount, OArr(), i
                If TypeName(ArrayObject(0)) = "String" Then
                    If ArrayObject(0) = "***Arr*initial***" Then
                        ReDim OArr(0)
                        OArr(0) = item
                    Else
                        ArrCount = UBound(ArrayObject)
                        ReDim OArr(ArrCount + 1)
                        For i = 0 To ArrCount
                            OArr(i) = ArrayObject(i)
                        Next
                        OArr(ArrCount + 1) = item
                    End If
                Else
                    ArrCount = UBound(ArrayObject)
                    ReDim OArr(ArrCount + 1)
                    For i = 0 To ArrCount
                        OArr(i) = ArrayObject(i)
                    Next
                    OArr(ArrCount + 1) = item
                End If
                Add = OArr
            End Function
            Function IsExistInArray(ArrayObject, MatchingValue) '判断数组中是否存在某一元素
                Dim i
                Dim RB As Boolean
                RB = False
                For i = 0 To UBound(ArrayObject)
                    If MatchingValue = ArrayObject(i) Then
                        RB = True
                        Exit For
                    End If
                Next
                IsExistInArray = RB
            End Function
            Function GetIndex(ArrayObject, MatchingValue)  '返回元素所在的位置
                Dim i
                Dim RB, IndexArr
                IndexArr = Reset()
                For i = 0 To UBound(ArrayObject)
                    If MatchingValue = ArrayObject(i) Then
                        IndexArr = i
                        Exit For
                    End If
                Next
                GetIndex = IndexArr
            End Function
            Function GetIndexs(ArrayObject, MatchingValue) '返回元素所在的位置(数组)
                Dim i
                Dim RB, IndexArr
                IndexArr = Reset()
                For i = 0 To UBound(ArrayObject)
                    If MatchingValue = ArrayObject(i) Then
                        IndexArr = Add(IndexArr, i)
                    End If
                Next
                GetIndexs = IndexArr
            End Function
        End Class

    ======读写文件函数====

        Class text
            Sub swrite(filename, content)
                Dim stream
                stream = CreateObject("Adodb.Stream")
    
                stream.Open
                stream.Type = 2 '"adTypeText"
                stream.Charset = "utf-8"
                stream.WriteText(content)
    
                '移除前三个字节(0xEF,0xBB,0xBF)
                stream.Position = 3
    
                Dim newStream
                newStream = CreateObject("Adodb.Stream")
                newStream.Type = 1 '"adTypeBinary"
                newStream.Mode = 3 '"adModeReadWrite"
                newStream.Open
    
                stream.CopyTo(newStream)
                stream.Flush
                stream.Close
    
                newStream.SaveToFile(filename, 2) '"adSaveCreateOverWrite"
                newStream.Flush
                newStream.Close
            End Sub
            Function sread(Path)
                Dim stm
                stm = CreateObject("Adodb.Stream")
                stm.Type = 2
                stm.Mode = 3
                stm.Charset = "UTF-8"
                stm.Open
                stm.LoadFromFile(Path)
                sread = stm.ReadText()
                stm.close()
                'stm = Nothing
            End Function
    
            Function Read(filePath As String)
    
                Dim txt As StreamReader
                Dim st As String, isComment As Boolean = False
                Dim isMutiLineComment As Boolean = False
                Dim isInString As Boolean = False
                txt = New StreamReader(filePath)
                st = txt.ReadToEnd
                Read = st
                txt.Close()
            End Function
            Sub save(path As String, str As String)
                Using logObject As System.IO.StreamWriter = New System.IO.StreamWriter(path)
                    logObject.Write(str)
                    logObject.Close()
                End Using
            End Sub
        End Class
    ======json========

        Class json
            Dim arr As New Arr
            Function jsStrToRead(jsStr)   '将json字符串转换为便于阅读的格式
                Dim thisChar As Char
                Dim NodeCount As Int64 = 0
                Dim isInString As Boolean = False
                Dim ns = ""
                For Each thisChar In jsStr
                    Select Case thisChar
                        Case "{"
                            ns = ns & thisChar & Chr(13)
                            NodeCount = NodeCount + 1
                            ns = ns & writeBlank(NodeCount)
                        Case "}"
                            NodeCount = NodeCount - 1
                            ns = ns & Chr(13) & writeBlank(NodeCount) & thisChar
                        Case "["
                            NodeCount = NodeCount + 1
                            ns = ns & thisChar & Chr(13) & writeBlank(NodeCount)
                        Case "]"
                            NodeCount = NodeCount - 1
                            ns = ns & Chr(13) & writeBlank(NodeCount) & thisChar
                        Case ","
                            If isInString = False Then
                                ns = ns & thisChar & Chr(13) & writeBlank(NodeCount)
                            Else
                                ns = ns & thisChar
                            End If
                        Case ":"
                            If isInString = False Then
                                ns = ns & " " & thisChar & " "
                            Else
                                ns = ns & thisChar
                            End If
                        Case """"
                            isInString = Not isInString
                            ns = ns & thisChar
                        Case Else
                            ns = ns & thisChar
                    End Select
                    'Stop
                Next
                Return ns
            End Function
    
            Function writeBlank(nodecount)    '根据层数,返回用于首行缩进的字符串
                Dim s = ""
                For i = 1 To nodecount
                    s = s & Chr(9)
                Next
                'Stop
                Return s
            End Function
            Function jsObjectToStr(JsObject)  '将json对象转换为json字符串
                Dim ItemKey, ItemVal, ItemType, ValSt, NameSt
                Dim jst As String = "{"
                For i = 0 To UBound(JsObject(0))
                    ItemKey = JsObject(0)(i)
                    ItemVal = JsObject(1)(i)
                    ItemType = JsObject(2)(i)
                    ValSt = ""
                    Select Case ItemType
                        Case "string"
                            ValSt = """" & ItemVal & """"
                        Case "value"
                            ValSt = ItemVal
                        Case "array_Str"
                            ValSt = "["
                            For j = 0 To UBound(ItemVal)
                                ValSt = ValSt & """" & ItemVal(j) & """" & ","
                            Next
                            ValSt = Left(ValSt, Len(ValSt) - 1) & "]"
                        Case "array_Val"
                            ValSt = "["
                            For j = 0 To UBound(ItemVal)
                                ValSt = ValSt & ItemVal(j) & ","
                            Next
                            ValSt = Left(ValSt, Len(ValSt) - 1) & "]"
                        Case "object"
                            ValSt = ItemVal
                    End Select
                    NameSt = """" & ItemKey & """"
                    jst = jst & NameSt & ":" & ValSt & ","
                Next
                jst = Left(jst, Len(jst) - 1) & "}"
                Return jst
            End Function
            Function setValue(jsObject, KeyName, NewValue, NewType) '输入Key的名称,并修改对于的数值
                Dim jsName, njsObject
                njsObject = jsObject
                For i = 0 To UBound(njsObject(0))
                    jsName = njsObject(0)(i)
                    If jsName = KeyName Then
                        njsObject(1)(i) = NewValue
                        If NewType <> "" Then
                            njsObject(2)(i) = NewType
                        End If
                        Exit For
                    End If
                Next
                Return njsObject
            End Function
            Function Formate(st)     '去掉json字符串中的空格/换行符等无意义的字符
                Dim thisChar As Char
                Dim isInString As Boolean = False
                Dim nst = ""
                For Each thisChar In st
                    Select Case thisChar
                        Case " "
                            If isInString = True Then
                                nst = nst & thisChar
                            End If
                        Case Chr(13)
                        Case Chr(10)
                        Case Chr(9)
                        Case """"
                            isInString = Not isInString
                            nst = nst & thisChar
                        Case Else
                            nst = nst & thisChar
                    End Select
                Next
                Return nst
            End Function
            Function GetValueType(jsValue)   '获取一个json字符中,值的类型
                Dim firstChar, SecondChar, tt
                firstChar = Mid(jsValue, 1, 1)
                SecondChar = Mid(jsValue, 2, 1)
                If firstChar = """" Then
                    tt = "string"
                ElseIf IsNumeric(jsValue) = True
                    tt = "value"
                ElseIf firstChar = "[" Then
                    If SecondChar = """" Then
                        tt = "array_Str"
                    Else
                        tt = "array_Val"
                    End If
    
                ElseIf firstChar = "{" Then
                    tt = "object"
                Else
                    tt = "error"
                End If
                GetValueType = tt
            End Function
            Function GetJsKeyValue(jsonObject)  
                Dim thisChar
                Dim mmp = 0
                Dim isInstring As Boolean = False
                For i = 1 To Len(jsonObject)
                    thisChar = Mid(jsonObject, i, 1)
                    Select Case thisChar
                        Case """"
                            isInstring = Not isInstring
                        Case ":"
                            If isInstring = False Then
                                mmp = i
                                Exit For
                            End If
                    End Select
                Next
                Dim keyValue
                keyValue = Mid(jsonObject, mmp + 1, Len(jsonObject) - mmp)
                Return keyValue
            End Function
            Function GetJsKeyName(jsonObject)  '获取key的名字
                Dim thisChar
                Dim mmp = 0
                Dim isInstring As Boolean = False
                For i = 1 To Len(jsonObject)
                    thisChar = Mid(jsonObject, i, 1)
                    Select Case thisChar
                        Case """"
                            isInstring = Not isInstring
                        Case ":"
                            If isInstring = False Then
                                MMP = i
                                Exit For
                            End If
                    End Select
                Next
                Dim keyname
                keyname = Mid(jsonObject, 2, mmp - 3)
                Return keyname
            End Function
            Function GetJsValueByName(jsObject, KeyName) 
                Dim v
                v = ""
                For i = 0 To UBound(jsObject(0))
                    If KeyName = jsObject(0)(i) Then
                        v = jsObject(1)(i)
                        Exit For
                    End If
                Next
                Return v
            End Function
            Function GetJsItemObjectArr(jsonValue)  
                Dim njsVal = Formate(jsonValue)
                Dim thisChar As Char
                Dim NodeCount As Int64 = 0
                Dim isInString As Boolean = False
                Dim SplitPositon, jsObject
                SplitPositon = arr.Reset()
                jsObject = arr.Reset()
                SplitPositon = arr.Add(SplitPositon, 1)
                For i = 1 To Len(njsVal)
                    thisChar = Mid(njsVal, i, 1)
                    Select Case thisChar
                        Case "{"
                            NodeCount = NodeCount + 1
    
                        Case "}"
                            NodeCount = NodeCount - 1
                            If NodeCount = 0 Then
                                SplitPositon = arr.Add(SplitPositon, i)
                            End If
                        Case "["
                            NodeCount = NodeCount + 1
                        Case "]"
                            NodeCount = NodeCount - 1
                        Case """"
                            isInString = Not isInString
                        Case ","
                            If isInString = False And NodeCount = 1 Then
                                SplitPositon = arr.Add(SplitPositon, i)
                            End If
                    End Select
                Next
                Dim SP, EP, Stlenth
    
                For i = 0 To UBound(SplitPositon) - 1
                    SP = SplitPositon(i) + 1
                    EP = SplitPositon(i + 1)
                    Stlenth = EP - SP
                    jsObject = arr.Add(jsObject, Mid(njsVal, SP, Stlenth))
                Next
                'Stop
                Return jsObject
            End Function
    
            Function jsonReader(st)
                Dim isInString As Boolean = False
                Dim jsobject = GetJsItemObjectArr(st)
                Dim KeyNameArr, KeyName, KeyValue, ValueType, KeyValueArr, ValueTypeArr
                Dim jsonReaderObj
                KeyNameArr = arr.Reset()
                KeyValueArr = arr.Reset()
                ValueTypeArr = arr.Reset()
                jsonReaderObj = arr.Reset()
                For i = 0 To UBound(jsobject)
                    KeyName = GetJsKeyName(jsobject(i))
                    KeyValue = GetJsKeyValue(jsobject(i))
                    ValueType = GetValueType(KeyValue)
                    Select Case ValueType
                        Case "string"
                            KeyValue = Mid(KeyValue, 2, Len(KeyValue) - 2)
                        Case "value"
                            KeyValue = Val(KeyValue)
                        Case "array_Str"
                            KeyValue = Mid(KeyValue, 3, Len(KeyValue) - 4)
                            KeyValue = Split(KeyValue, """,""")
                        Case "array_Val"
                            KeyValue = Mid(KeyValue, 2, Len(KeyValue) - 2)
                            KeyValue = Split(KeyValue, ",")
                            For j = 0 To UBound(KeyValue)
                                KeyValue(j) = Val(KeyValue(j))
                            Next
                        Case "object"
                            KeyValue = KeyValue
                    End Select
                    KeyNameArr = arr.Add(KeyNameArr, KeyName)
                    KeyValueArr = arr.Add(KeyValueArr, KeyValue)
                    ValueTypeArr = arr.Add(ValueTypeArr, ValueType)
                Next
                jsonReaderObj = arr.Add(jsonReaderObj, KeyNameArr)
                jsonReaderObj = arr.Add(jsonReaderObj, KeyValueArr)
                jsonReaderObj = arr.Add(jsonReaderObj, ValueTypeArr)
    
                Return jsonReaderObj
            End Function
    
        End Class
    ========调用例子========

    dim t as new text, js as new json

    dim FilePath as string = "json的文件路径\json.dat"

    dim jsonObject  = js.jsonReader(FilePath)

    dim JsKeyArr = jsonObject(0)    'json的key的数组

    dim JsValueArr = jsonObject(1)  'json的值的数组

    dim JsTypeArr = jsonObject(2)  'json的各个值的类型数组

    dim KVal = js.GetJsValueByName(jsonObject, "Key的名称")

    jsonObject = js.setValue(jsonObject, "Key的名称" , 新的值 , 值的类型)


    展开全文
  • 但是从其中提炼数据也让人觉得很烦躁,基本上就是不断的查找,截取,或者组装成JS代码执行返回值,很麻烦一个方便的JSON模块还是很有必要的 先把构思图保存下,明天有时间再实现方法... 转载于:...

    现在抓取网页数据的时候,经常会遇到JSON的数据,相对于繁杂无标签名的HTML源,用JSON传回的数据比较直观好看点.
    但是从其中提炼数据也让人觉得很烦躁,基本上就是不断的查找,截取,或者组装成JS代码执行返回值,很麻烦
    写一个方便的JSON模块还是很有必要的

    先把构思图保存下,明天有时间再写实现方法...

    转载于:https://www.cnblogs.com/xiii/p/4987334.html

    展开全文
  • 因为公司的实际需求,近期的项目都会部署到一个服务器上,通过宝塔来管理服务器上的网站,比较方便,但是近期网站系统偏向于vue开发,也就是说完了,本地编译,打包上传到服务器,服务器解压,这个流程对于我们来...
  • 我用VB.NET 的webservice调用下面函数,然后调用函数DataTableToJson转换为JSON格式,但是app端读取出来说还是XML格式?但是我本地调试看了下返回结果:{"Count":"1","Data":[{"ID":"2","Guid":"310b6649ea9c4139...
  • 这几天打算一个工具类JsonXmlHelper,用来进行用XML来保存JSON格式文件的工作。该工具类中要实现2个最主要的函数: 1)将JSON格式的内容写入到地址为address的XML中:WriteJsonToXml 2)把函数1中构造的XML文件...
  • 再谈VB2008中使用JSON

    千次阅读 2007-12-14 15:59:00
    前段时间我在Csdn上发表了一篇文章 VB2008使用.Net3.5扩展方法实现对象JSON序列化 至于如何将数据库的数据序列化成JSON,可以先创建实体类,然后把数据库的数据取出来进实体类中,再参考上面文章的方法序列化成...
  • VB.NET读写MongoDB

    千次阅读 2015-08-14 11:02:11
    VB.NET读写MongoDB MongoDB是一个基于分布式文件存储的数据库。由C++编写,旨在为WEB应用程序提供可扩展的高性能数据存储解决方案。 MongoDB是一个介于关系数据库和非关系数据库之间的产品,是非关系数据库中功能最...
  • vb.net 读写cookie

    2021-02-09 13:02:16
    cookie Dim JSONCookie As New HttpCookie("JSONDATA") JSONCookie.Expires = DateTime.Now.AddMinutes(480) JSONCookie.Value = cookiestr HttpContext.Current.Response.Cookies.Add(JSONCookie) 读...
  • Excel转JSON

    千次阅读 2017-01-08 10:13:09
    由于项目需要, 需要将特定的Excel文件提取为JSON, 试了Office2013版本后...但是之前看过一点VBA, 所以才鼓足勇气写vb脚本解决问题.下面的代码由于工作原因, 不能有太多注释, Excel文件也无法提供, 仅以此留念我的执着.S
  • C#处理json数据

    2016-02-24 11:37:22
    vb太苦逼了,很多资料都没有,没办法弄个C#的来学习一下,的很好的。  JSON(全称为JavaScript Object Notation) 是一种轻量级的数据交换格式。它是基于JavaScript语法标准的一个子集。 JSON采用完全独立于语言的...
  • JSON是网络上常用的数据格式,但是VB没有解析库,所以参考JSON数据语法了这个类模块,代码中演示了构造JSON数据,解析数据、修改数据相关属性构造新数据。经过测试,比JS解析、构造方式的速度快。
  • 首先这个实例是用vb写的,是asp不是asp.net aspx与asp是不同的,asp是一个运行环境,默认的脚本语言是vb, aspx是asp.net的一种文件类型 可用c#也可用vb 其次 asp中并没有能直接返回json格式的函数或者类,需要...
  • 我用VB6.0封装ASP代码(不是ASPX),其中有一个代码需要为JSCRIPT,也就是解析JSON的代码 ``` ... Array.prototype.get = function(x) { return this[x];... function parseJSON(strJSON) {...就是不知道如何VB类中
  • 几年没代码了,最近要弄个小东西,给手机端提供json数据,不想麻烦别人,自己又只会asp,没办法就自己动手了。网上找了好久都没有一个人能完整的把asp操作json说清楚。最后还是自己搞定的。整出来共享给大家。(ps...
  • 当你编译C#、F#或http://VB.NET代码时,编译器不会将其编译成原生代码,而是将其编译成通用中间语言。然后,IL代码被CLR/CoreCLR编译成可以在CPU上运行的机器代码。我想给大家展示的是通过Microsoft.NET.Sdk.IL用纯...
  • 想撸一个以前很火的植物大战僵尸游戏, 在网上找了许多python版本的游戏,发现没有比较完整的,那就自己来一个把。图片资源是从github上下载的,因为图片资源有限,只能实现几种植物和僵尸。功能实现如下:支持的...
  • VBForJson.rar

    2019-11-08 07:59:58
    VB6.0 读写JSON文件源程序,程序可靠易用,程序包含源程序和实例。
  • 1:了解Http协议,可以了解Web应用程序前后端的交互2:可以模仿Http的post和...4:可以替代Webservice和dubbo这类的远程连接工具,直接通过http的post和get的方式,通过json来交换数据。在本文中列出了十三道HTTP常...
  • 看到一个网友的博客上了原理,根据原理了一个VB6 版的网易云音乐下载源码例子,包含一个http下载类模块、一个JSON解析类模块,很多数据类型都是JSON,这个例子也演示了JSON数据的解析提取。
  • 作为编程人员,设计人员不免经常需要书写技术文档,文档中经常...目前支持20中常用的程序代码格式,例如:delphi,C#,Java,JavaScript,Perl,C++,Python,JSON,XML,SQL,HTML,CSS,VB等等。欢迎同行使用指正!
  • 这个程序可能是他人来实现特定功能的, 但是因为要对Excel表格内容做调整,所以对应的程序也要做一定的修改。 点击加载项 可以看到,这个加载项的功能是把Excel表格的内容转换成JSON文件。 查看代码 鼠标点任一...
  • Vb.Net 4.8框架中。 需要的V4 API密钥。 产品特点 每小时更新一次,每小时更新15点。 轻松选择鞭打字段进行下载。 (最多50个) 轻松选择要下载的音色。 (最多3个) 在午夜运行一个事件以清除日志文件并...
  • 基于 Ajax 的聊天室

    2008-04-18 13:55:35
    <br>js也有一段时间了,发现再用vbscriptasp,有点不适应vb的语法,因此服务端application的全部使用Jscript操作。(js真tmd的自由!自由到连个像样子的IDE都没有-_-)。 <br>当前已知的bug: 如果...
  • Java局域网通信——飞鸽传书源代码 28个目标文件 内容索引:JAVA源码,媒体网络,飞鸽传书 Java局域网通信——飞鸽传书源代码,大家都知道VB版、VC版还有Delphi版的飞鸽传书软件,但是Java版的确实不多,因此这个Java...

空空如也

空空如也

1 2
收藏数 34
精华内容 13
关键字:

vb写json