标题:用VB6来完成POST提交data字串
只看楼主
xinqiangDN
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2021-1-4
结帖率:0
已结贴  问题点数:20 回复次数:4 
用VB6来完成POST提交data字串
我用POST将参数值data字串{"pxh":"1","pfl":"3","pzl":"7246.1",...,"recipeWJJ1":"12.1"}提交,在网上测试成功,如下:

因为实际使用中data字串是我用VB6从SQL数据库中读取拼接的,所以要用VB6来完成POST提交data字串,以下是我用VB6写的:
 Dim Postdata As String
 Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
 Set http = CreateObject("Microsoft.XMLHTTP") '创建请求对象
 Url = "http://101.200.202.124/ext/station/scrw/saveData/" '设置POST请求的Url
 http.Open "POST", Url, False '异步方式建立请求链接
 http.setRequestHeader "token", "1201030104" '设置请求头
 http.setRequestHeader "mixer", 57
 http.setRequestHeader "no", 20201231-297
 http.setRequestHeader "Content-Type", "form-data; boundary=" & STR_BOUNDARY '设置boundary
'封装POSTbody:(其中data是JSON格式字串{"pxh":"1","pfl":"3","pzl":"7246.1",...,"recipeWJJ1":"12.1"}
 Postdata = "--" & STR_BOUNDARY & vbCrLf _
 & "Content-Disposition: form-data; key=""data""" & "; value=" & data & vbCrLf _
 & "--" & STR_BOUNDARY & "--"
 http.Send (Postdata) '发送POST请求

但是请求后得到错误回复:
http.responseText "请求参数错误"

想请问高手,封装POSTbody中的"Content-Disposition: form-data; key=""data""" & "; value=" & data
我是根据网上测试界面写的,是不是有问题? 正确的应该怎么写? 请求赐教,谢谢!
搜索更多相关主题的帖子: 请求 http VB6 data POST 
2021-01-04 13:15
apull
Rank: 16Rank: 16Rank: 16Rank: 16
来 自:三体星系
等 级:版主
威 望:185
帖 子:1404
专家分:8479
注 册:2010-3-16
得分:10 
把data里的双引号改成单引号了试试
2021-01-04 14:37
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:10 
感觉问题在这: "Content-Disposition: form-data; key=""data""" & "; value=" & data & vbCrLf _
这里面得到的 key="data" 是对的吗? 不是 ... key=""" & date & """ ...

你抓包的原始数据是什么?
你显示了你生成的post数据,然后与你原始的post数据对比过了没?

授人于鱼,不如授人于渔
早已停用QQ了
2021-01-04 21:18
或与非1
Rank: 2
等 级:论坛游民
帖 子:5
专家分:10
注 册:2020-2-9
得分:0 
这是我做的一段vb6调用百度分词api,发送json POST的,用的嗷嗷叫的老马的现成函数。
POST JSON数据时,格式应该是有换行的,
不是
{}

而是
{
}


程序代码:
Option Explicit
Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001
Public Const BAIDU_APP_KEY = "你的APP KEY" '在百度申请后得到

Public Const BAIDU_SECRET_KEY = "你的SECRET KEY" '在百度申请后得到
Public Function strCut(strContent, strStart, strEnd) As String '文件截取函数
Dim strHTML, s1, s2 As String
strHTML = strContent
On Error Resume Next
s1 = InStr(strHTML, strStart) + Len(strStart)
s2 = InStr(s1, strHTML, strEnd)
strCut = Mid(strHTML, s1, s2 - s1)
End Function
Private Function GetToken() As String
Dim HTTP As Object
Dim URL As String
Dim Buff() As Byte
On Error GoTo wrong
Set HTTP = CreateObject("WinHttp.WinHttpRequest.5.1") '创建WinHttpRequest对象
URL = "https://aip." & BAIDU_APP_KEY & "&client_secret=" & BAIDU_SECRET_KEY & "&"
With HTTP
.setTimeouts 50000, 50000, 50000, 50000 '设置超时时间
.Open "GET", URL, True
.send
.waitForResponse
If .Status = 200 Then '成功获取页面
Buff = .ResponseBody
GetToken = strCut(Utf8ToUnicode(Buff), "access_token"":""", """,""scope")
Else
MsgBox "Http错误代码:" & .Status, vbInformation, "提示"
End If
End With
Set HTTP = Nothing
Exit Function
wrong:
MsgBox "错误原因:" & Err.Description & "", vbInformation, "提示"
Set HTTP = Nothing
End Function
Private Function Utf8ToUnicode(ByRef Utf() As Byte) As String 'utf-8解码
Dim lRet As Long
Dim lLength As Long
Dim lBufferSize As Long
lLength = UBound(Utf) - LBound(Utf) + 1
If lLength <= 0 Then Exit Function
lBufferSize = lLength * 2
Utf8ToUnicode = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
If lRet <> 0 Then
Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
Else
Utf8ToUnicode = ""
End If
End Function
Public Function HttpPOST(ByVal JSONData As String) As String
Dim HTTP As Object
Dim URL As String
Dim Buff() As Byte
URL = "https://aip." & GetToken
Set HTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
With HTTP
.setTimeouts 50000, 50000, 50000, 50000 '设置超时时间
.Option(6) = False
.Option(4) = 13056
.Open "POST", URL
.setRequestHeader "Content-Length", LenB(StrConv(JSONData, vbFromUnicode))
.send JSONData
.waitForResponse
If .Status = 200 Then '成功获取页面
Buff = .ResponseBody
HttpPOST = Utf8ToUnicode(Buff)
End If
End With
Set HTTP = Nothing
End Function



[此贴子已经被作者于2021-3-4 23:20编辑过]

2021-03-04 23:17
llx1003
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2010-4-10
得分:0 
楼主是怎么解决的?
2021-09-28 21:11



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-504518-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.240429 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved