vb写json

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利用官方api读写JSON数据格式文件简单实例.zip
2019-10-14 01:05:28
vb6读写json格式文件，这里是源码，可以直接拿来使用。
收起
VB利用官方api读写JSON数据格式文件简单实例
热门讨论 2013-09-05 15:56:11
VB利用官方api读写JSON数据格式文件简单实例,是一个非常、非常简单的例子…………
收起
json数据读写
vb.net json 字符串拼接
2017-07-25 10:14:24
VB.NET json字符串拼接
收起
vb.net
VB解析JSON案例
2015-09-18 15:35:25
简单实用的案例，一看就能理解，内容包含解析JSON字符串和JS脚本。
收起
VB解析JSON
VB6解析json类库-5分，完整示例，亲测可用
2020-07-22 15:03:47
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 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

收起

展开全文

vb6 Json

VB 分析json数据有实例代码
热门讨论 2013-11-23 16:44:37
vb json 代码有实例有代码，欢迎大家使用，谢谢！
收起
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属性字段
收起
解析JSON
VB6_Json解析代码
2015-03-24 23:39:46
VB6_Json解析代码
收起
VB.NET XML和JSON序列化与反序列化
2020-12-15 15:16:23
VB.NET XML和JSON序列化与反序列化,根据实体类可以快速解析XML和json文件,和生成xml,json文件
收起
VB.net DataSet和JSON形式的数据相互转换
2015-05-21 14:48:11
VB.net中DataSet和JSON形式的数据相互转换的代码，可以拿来直接说用
收起

vb.net 使用dsapi, 读写json文件

2021-10-20 15:16:00

$"{当前程序所在文件夹()}\保存.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

收起

展开全文

json vb.net

VB6.0 json操作与中文乱码处理
2021-01-09 22:51:43
经过一番探索，找到了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解析类库，里面含有简单的实例。
收起
VB.NET使用JSON.NET集合序列及反序列实例
2020-05-12 13:21:06
Imports Newtonsoft.Json Imports Newtonsoft.Json Public Class Form1 Public Sub New() ' 此调用是设计器所必需的。 InitializeComponent() ' 在 InitializeComponent() 调用之后添加任何初始化。 Dim ...
收起
json vb.net
VB.NET解析json字符串
千次阅读 2019-01-08 07:32:05
利用NuGet包管理器控制台安装好newtonsoft.json.输入命令：Install-Package Newtonsoft.Json 我建立了一个控制台程序：运行结果：代码： Imports Newtonsoft.Json.Linq Module ...
收起
vb.net json 解析字符串
vb6里解析json数据
万次阅读 2018-09-17 18:28:34
vb6里不支持json对象，这里使用通过引用js来实现json的解析获取简单的json串里的值遍历json键值对较多的复杂json串
收起
vb6 json
vb6解析josn数组.txt
2020-03-31 17:54:02
在数组中[]包含json里面有数组元素的话，可以通过他解析，亲测好使！
收起
VB.NET 读取JSON数据问题
2021-06-12 15:38:50
字符串如下： {"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该如何写操作
收起

VB 写json报文

已经实现了：（含源码）VB利用官方api读写JSON数据格式文件简单实例.zip

VB利用官方api读写JSON数据格式文件简单实例

vb.net json 字符串拼接

VB解析JSON案例

VB6解析json类库-5分，完整示例，亲测可用

VB_JSON.zip

VB解析Json转换为Xml

JSON VB6使用模块

【vb.net】json文件的读写

VB6 Json字符串合成

VB 分析json数据有实例代码

VB6 处理Json数据源码

VB解析JSON

VB6_Json解析代码

VB.NET XML和JSON序列化与反序列化

VB.net DataSet和JSON形式的数据相互转换

vb.net 使用dsapi, 读写json文件

VB6.0 json操作与中文乱码处理

VB.NET JSON的使用

VB JSON解释类

VB 解析 JSON

VB6解析json类库

VB.NET使用JSON.NET集合序列及反序列实例

VB.NET解析json字符串

vb6里解析json数据

vb6解析josn数组.txt

VB.NET 读取JSON数据问题