精华内容
下载资源
问答
  • 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

     

    展开全文
  • vb6读写json格式文件,这里是源码,可以直接拿来使用。
  • VB利用官方api读写JSON数据格式文件简单实例,是一个非常、非常简单的例子…………
  • vb.net json 字符串拼接

    2017-07-25 10:14:24
    VB.NET json字符串拼接
  • VB解析JSON案例

    2015-09-18 15:35:25
    简单实用的案例,一看就能理解,内容包含解析JSON字符串和JS脚本。
  • VB6 中使用JSON的类库,有完整示例工程。亲测可用,仅需5积分,比同类资源动辄几十分性价比高多了。赶紧下载用吧。
  • VB_JSON.zip

    2020-05-08 20:02:33
    JSON 简介 VB-JSON是一个Visual Basic 6类库,用于解析和发出JSON(JavaScript对象表示法),并且可以处理数据中的嵌套数组和对象。它不依赖JScript引擎进行解析。 JSON是一种有用且紧凑的格式,用于在基于浏览器...
  • VB解析Json转换为Xml

    2016-10-25 15:01:04
    VB解析Json转换为Xml。内有详细使用代码例子
  • JSON VB6使用模块

    2018-03-01 15:48:16
    JSON VB6中使用模块,带有有一个例子程序,请大家参考。
  • 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的名称" , 新的值 , 值的类型)


    展开全文
  • VB6 Json字符串合成

    2021-01-24 14:18:34
    Public Function dictToJson(pDicX As Dictionary, Optional ByVal isEscape As Boolean = ... '字典转为带有转义符号的json ' 参数: ' isEscape 是否传出携带转义的字符串[默认有转义符号] ' isObjBeginEndAddYi...
    Public Function dictToJson(pDicX As Dictionary, Optional ByVal isEscape As Boolean = True, Optional ByVal isObjBeginEndYinHao As Boolean = False) As String
    
        '字典转为带有转义符号的json
        '   参数:
        '   isEscape 是否传出携带转义的字符串[默认有转义符号]
        '   isObjBeginEndAddYinHao[默认关闭]    者{} 前后是否增加引号显示    value是否字典前面或者数组前面增加引号   ,"{    或者    ,{            。后面为 }"  或者  }
        
        '......入参Demo
        'Dim pDicX As Dictionary
        'Set pDicX = New Dictionary
        'or Dim pDicX As New Dictionary
        'pDicX.Add "A", 100
        
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
        '空检测
        If IsNull(pDicX) Or TypeName(pDicX) <> "Dictionary" Then
            dictToJson = ""
            Exit Function
        End If
        
        '..........字典转json
        Dim sStr As String
        Dim i As Integer
        Dim keyArray As Variant, itemArray As Variant
        keyArray = pDicX.keys
        itemArray = pDi
    展开全文
  • VB 分析json数据有实例代码

    热门讨论 2013-11-23 16:44:37
    vb json 代码有实例有代码,欢迎大家使用,谢谢!
  • VB6 处理Json数据源码

    热门讨论 2014-06-27 11:39:08
    Visual Basic 6 处理Json源码,使用方便,网络数据传输应用
  • VB解析JSON

    2018-09-08 15:16:22
    VB解析JSON,可以解析多层JSON,解析多种JSON属性字段
  • VB6_Json解析代码

    2015-03-24 23:39:46
    VB6_Json解析代码
  • VB.NET XML和JSON序列化与反序列化,根据实体类可以快速解析XML和json文件,和生成xml,json文件
  • VB.net中DataSet和JSON形式的数据相互转换的代码,可以拿来直接说用
  • $"{当前程序所在文件夹()}\保存.dat" If 存在文件(文件路径) = 否 Then Exit Sub 信息 = 读取文本文件(文件路径).Json反序列化(Of 保存信息) End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) ...

    dsapi是一种非常强大的扩展方法,学习与使用见群419130936

    Public Class Form3
        Private 信息 As New 保存信息
        Private Sub Form3_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            Dim 文件路径 As String = $"{当前程序所在文件夹()}\保存.dat"
            If 存在文件(文件路径) = 否 Then Exit Sub
            信息 = 读取文本文件(文件路径).Json反序列化(Of 保存信息)
    
        End Sub
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    
            With 信息
                .账号 = TextBox1.Text
                .密码 = TextBox2.Text
                .上次登录时间 = 当前时间()
            End With
            信息.Json序列化.保存到文件($"{当前程序所在文件夹()}\保存.dat")
        End Sub
    
    
    End Class
    <Serializable>
    Public Class 保存信息
        Public 账号 As String
        Public 密码 As String
        Public 上次登录时间 As Date
    End Class
    
    
    Public Class 冲击冷却
        Public Cn As Single
        Public Zn As Single
        Public d As Single
        Public f1 As Single
        Public AH As Single
        Public Num As Single
        Public Function Z(airwx As Single()) As Single
            Return Z
        End Function
        Public Function Nu(airwx As Single()) As Single
            Return Nu
        End Function
    
    End Class
    

    展开全文
  • 经过一番探索,找到了VBJSON这个库。 使用过程如下: 1. 下载VBJSON:http://www.ediy.co.nz/vbjson-json-parser-library-in-vb6-xidc55680.html 目录内容如下: 2. 在工程中引用VBJSON 右击工程名称-》添加-...
  • VB.NET JSON的使用

    2019-07-24 14:36:34
    首先要下载Newtonsoft.Json,如果你用的是VisualStudio 2017,可以右击【解决方法】选择点击【管理解决方案的NuGet程序包】,在浏览的搜索框内输入“Newtonsoft.Json”,根据你需要的版本下载程序包。 简单应用 1 ...
  • VB JSON解释类

    2018-07-06 10:26:37
    VB JSON解释类 ,VB 操作JSON 也能非常 6666666 ,值得拥有。
  • VB 解析 JSON

    千次阅读 2017-07-15 23:29:31
    {"ecode":0,"exp":4,"limit":0,"pkg":[{"id":1,"name":"元宝","num":1000,"type":39}],"ref_limit":0,"ret":0,"wish_num":1,"wish_t":1499612867} ...Public Function Json(ByVal JSONPath As String, ByVal JSONS
  • VB6解析json类库

    热门讨论 2011-04-27 18:04:38
    十分简洁明了的一个json解析类库,里面含有简单的实例。
  • Imports Newtonsoft.Json Imports Newtonsoft.Json Public Class Form1 Public Sub New() ' 此调用是设计器所必需的。 InitializeComponent() ' 在 InitializeComponent() 调用之后添加任何初始化。 Dim ...
  • VB.NET解析json字符串

    千次阅读 2019-01-08 07:32:05
    利用NuGet包管理器控制台安装好newtonsoft.json.输入命令:Install-Package Newtonsoft.Json 我建立了一个控制台程序: 运行结果: 代码:   Imports Newtonsoft.Json.Linq Module ...
  • vb6里解析json数据

    万次阅读 2018-09-17 18:28:34
    vb6里不支持json对象,这里使用通过引用js来实现json的解析 获取简单的json串里的值 遍历json键值对较多的复杂json
  • vb6解析josn数组.txt

    2020-03-31 17:54:02
    在数组中[]包含json里面有数组元素的话,可以通过他解析,亲测好使!
  • 字符串如下: {"farmlandStatus":[{"a":15,"b":6,"c":0,"d":0,"e":1,"f":0,"g":0,"h":1,"i":100,"j":1,"k":26,"l":15,"m":15,"n":{"227554197":1,"276748590":1,"239255726":1,"238907507":1,... VB.NET该如何操作

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 10,149
精华内容 4,059
关键字:

vb写json