VB如何发送JSON数据到上级单位系统中，急求大神支招！谢谢！

cdsqkj 2022-09-03 01:07:09

上级单位网址“http://122.56.xx.xxx:8088/index",用户名：xxx,密码:xxxx，要求数据格式打包成JSON上传。

我想通过VB实现数据上传，并能接收传输成功与否的反馈信息，网上查了下winhttp用法，做了一个没成功，

请大侠指点！

上级单位JSON数据要求：

1、接口类型：POST

数据内容：JSON

{

"user":"admin",

"data":{ "category":"供方分类",

"vcode":"供方编码",

"name":"供方名称",

}

返回数据：JSON

{

"code": 0, //0-成功 1-失败

"msg": "上传成功", //提示信息

"data": null //上传的原始数据对象

}

以下为VB上传代码：

Private Sub Command3_Click()
Dim str As String
str = SendData
URL = "http://122.56.xx.xxx:8088/index”

Debug.Print HttpPOST(URL, str)

End Sub

Private Function SendData() As String
Dim str As String
str = "{"
str = str & vbCrLf & """user""" & ":" & """admin""" & ","
str = str & vbCrLf & """data""" & ":" & "{"
str = str & vbCrLf & """category""" & ":" & """主材供应商""" & ","
str = str & vbCrLf & """vcode""" & ":" & """002""" & ","
str = str & vbCrLf & """name""" & ":" & """test"""
str = str & vbCrLf & " }"
str = str & vbCrLf & "}"
SendData = str
Debug.Print str
End Function

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(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300

HTTP.SetTimeouts 6000, 15000, 60000, 60000

HTTP.Option(6) = False
HTTP.Option(4) = 13056
HTTP.Open "POST", URL, False

HTTP.SetCredentials "用户名", "密码", 1
HTTP.SetRequestHeader "Content-Type", "application/json"
HTTP.SetRequestHeader "Content-Length", LenB(StrConv(JSONData, vbFromUnicode))
HTTP.Send JSONData
HttpPOST = HTTP.ResponseText
HTTP.ResponseBody

Set HTTP = Nothing

End Function

...全文