VB怎么发送json报文呀

[♚至简｀]

VB怎么发送json报文呀，json已经生成了，想通过VB发送出去到指定地址，求大神帮忙！

[笨狗先飞]

无语了，就好比你说，“我有一条消息需要发出去，我该怎么发？”
手机？电话？微信？QQ?
json只是一个数据形式，问题的核心在通讯上，而不是这个json。

[♚至简｀]

那我再具体点，就是想我想实现将下边的内容，以web service的接口形式发送到接口地址，编码格式utf-8，数据格式为json 这个用VB怎么实现呀，拜托了大神！ https://WSUAT.Link-SPMIS.com/PosService/rest/salestransaction/salestranslitev61 {"apiKey":"STANDARD","signature":"luosifu","docKey":"2020-08-01.BJRPX000100.TEST0801. 20200801154126002","transHeader":{"txDate":"2020-08-01","ledgerDatetime":"2020-08-01 15:41:26","storeCode":"BJRPX000100","tillId":"01","docNo":"TEST0801. 20200801154126002"},"salesTotal":{"cashier":"BJRPX01","vipCode":"","netQty":"1","netAmount":"3","calculateVipBonus":"0"},"salesItem":[{"salesLineNumber":"1","itemCode":"BJRPX000100","itemOrgId":"","itemLotNum":"*","inventoryType":"0","qty":"1","itemDiscountLess":"0.00","totalDiscountLess":"0.00","extendParameter":"","calculateVipBonus":"0","netAmount":"3"}],"salesTender":[{"baseCurrencyCode":"RMB","tenderCode":"OH","payAmount":"3","baseAmount":"3","excessAmount":"0"}]}

[♚至简｀]

引用 1 楼 笨狗先飞 的回复:

无语了，就好比你说，“我有一条消息需要发出去，我该怎么发？” 手机？电话？微信？QQ? json只是一个数据形式，问题的核心在通讯上，而不是这个json。

web service接口，编码格式utf-8，数据格式为json

[笨狗先飞]

'用法
Debug.Print HttpPOST("Http://xxx.xxx.xxx","JSON 数据") 'URL参数里的 “Http://” 不能省

你试试看吧。

'方法一
Public Function HttpPOST(ByVal URL As String, ByVal JSONData As String = "") As String
    Dim HTTP As Object
    Set HTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    HTTP.Option(6) = False
    HTTP.Option(4) = 13056
    HTTP.Open "POST", URL
    HTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    HTTP.SetRequestHeader "Content-Length", LenB(StrConv(JSONData, vbFromUnicode))
    HTTP.Send JSONData
    HttpPOST = HTTP.ResponseText
    Set HTTP = Nothing
End Function

'方法二 这个方法我没验证过，可能需要自己修改
Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long

Public Function UTF8Decode(ByRef sUTF8() As Byte, Optional ByVal CodePage As Long = 65001) As String
    Dim lngUtf8Size As Long, lngBufferSize As Long, strBuffer As String, lngResult As Long
    On Error GoTo hErr
    If UBound(sUTF8) = 0 Then Exit Function
    lngUtf8Size = UBound(sUTF8) + 1
    lngBufferSize = lngUtf8Size * 2
    strBuffer = String(lngBufferSize, vbNullChar)
    lngResult = MultiByteToWideChar(CodePage, 0, sUTF8(0), lngUtf8Size, StrPtr(strBuffer), lngBufferSize)
    If lngResult Then UTF8Decode = Left(strBuffer, lngResult)
hErr:
End Function
 
Public Function UTF8Encode(ByVal strUnicode As String, Optional ByVal CodePage As Long = 65001) As Byte()
    Dim TLen As Long, lngBufferSize As Long, lngResult As Long, Arr() As Byte, I As Integer
    TLen = Len(strUnicode)
    If TLen = 0 Then Exit Function
    lngBufferSize = TLen * 3 + 1
    ReDim Arr(lngBufferSize - 1)
    lngResult = WideCharToMultiByte(CodePage, 0, StrPtr(strUnicode), TLen, Arr(0), lngBufferSize, vbNullString, 0)
    If lngResult Then
        lngResult = lngResult - 1
        ReDim Preserve Arr(lngResult)
        UTF8Encode = Arr
    End If
End Function

Public Function HttpPOST(ByVal URL As String, ByVal JSONData As String = "") As String
    Dim HTTP As Object,Arr() As Byte
    Set HTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    HTTP.Option(6) = False
    HTTP.Option(4) = 13056
    Arr=UTF8Encode(JSONData)
    HTTP.Open "POST", URL
    HTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    HTTP.SetRequestHeader "Content-Length", Ubound(Arr)+1
    HTTP.Send Arr
    Arr = HTTP.Responsebody
    HttpPOST=UTF8Decode(Arr)
    Set HTTP = Nothing
End Function

[笨狗先飞]

Public Function HttpPOST(ByVal URL As String, ByVal JSONData As String = "") As String 改成 Public Function HttpPOST(ByVal URL As String, ByVal JSONData As String) As String 不然提示有错 ================== 刚才试了一下，返回是空的，服务器那边可能有什么问题吧？或者确定是用post或者还是get提交的？

[♚至简｀]

方法一我试了下 成了 十分感谢！！！ "application/x-www-form-urlencoded"改成"application/json"即可

[排长性感的小屁屁]

请问vb生成json格式数据有什么方法吗