Question

vb6如何post json数据?

''使用WinHttp组件,发送Https请求
'' C:\WINDOWS\system32\WINHTTP.dll
'' Microsoft WinHTTP Services, version 5.1
Sub Main()

Dim aHttpRequest As WinHttp.WinHttpRequest
Dim sUrl As String
Dim sMethod As String
Dim sBody As String
Dim sResponse As String
Dim p As Object
Dim sInputJson As String

sInputJson = "{action: 'getAuth',key: '4TSTjLPldR9N2raG8RBRwcSXIuVKvRKHkPCnpr131HTBETqbIkMVzzcFMxOqL2b0',devices: ['zh1','zh2'],valid: 3600,time: 123123123,}"
Set p = JSON.parse(sInputJson)

sBody = JSON.toString(p)
sUrl = "https://storeauth.xxxxxx.net/api/openapi" '如 "https//xxxx:12306/yyyy"
sMethod = "POST" '或者(GET)

''创建WinHttp.WinHttpRequest
Set aHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")

'' 同步接收数据
aHttpRequest.Open sMethod, sUrl, False
'' 非常重要(忽略错误)
aHttpRequest.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
'' 其它请求头设置
'aHttpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'aHttpRequest.setRequestHeader "Content-Length", Len(sBody)

'' 发送
aHttpRequest.Send sBody

'' 得到返回文本(或者是其它)
sResponse = aHttpRequest.ResponseText
Text1.Text = sResponse

Debug.Print sResponse

Set aHttpRequest = Nothing

End Sub

谁帮我改一下，可以引用VBJSON的类

Answer 1

Public Function Ajax_Post(ByVal StrUrl As String, Optional ByVal StrData As String, Optional ByVal Index As Long) As Variant
    On Error GoTo MyError:
    Dim Object As Object, S As String, B() As Byte
    Set Object = CreateObject("Microsoft.XMLHTTP")
    Object.Open "POST", StrUrl, True
    Object.setRequestHeader "Content-Length", Len(Ajax_Post)
    Object.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    Object.send (StrData)
    Do Until Object.readyState = 4
        DoEvents
    Loop
    Select Case Index
        Case 1: S = Object.responseText: Ajax_Post = S '返回字符串
        Case 2: B = Object.responseBody: Ajax_Post = B '返回二进制
        Case 3: S = BytesToStr(Object.responseBody): Ajax_Post = S '二进制转字符串[直接返回字串出现乱码时尝试]
        Case Else: Ajax_Post = vbNullString '无效的返回
    End Select
    Set Object = Nothing '释放空间
    Exit Function
MyError:
    Ajax_Post = vbNullString '出错返回空
End Function
Function BytesToStr(ByVal vIn) As String
  Dim strReturn As String, ThisCharCode As String, NextCharCode As String, I As Long
  For I = 1 To LenB(vIn)
    ThisCharCode = AscB(MidB(vIn, I, 1))
    If ThisCharCode < &H80 Then
      strReturn = strReturn & Chr(ThisCharCode)
    Else
      NextCharCode = AscB(MidB(vIn, I + 1, 1))
      strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
      I = I + 1
    End If
  Next
  BytesToStr = strReturn
End Function
Private Sub Command1_Click()
    Dim Url As String, Key As Variant, JsonKey As String
    Url = "https://www.baidu.com/"
    Key = Array("wd=123", "aa=456", "bb=789", "cc=901")
    JsonKey = Join(Key, "&")
    MsgBox Ajax_Post(Url, JsonKey, 1)
End Sub

Answer 2

json中的内容中的“ 改为"" 试试

Answer 3

不知道我有没理解错，希望帮到你
form表单中的submit改成button
JS中做以下三步：
1.中先获取你需要的内容
2.把数据打包成json格式
3.form.submit()

追问

我要的是vb6.0得写法