[开发测试] vb6 PostMan接口测试 Ajax请求 HttpRequest

开发: C++知识库 Java知识库 JavaScript Python PHP知识库人工智能区块链大数据移动开发嵌入式开发工具数据结构与算法开发测试游戏开发网络协议系统运维
教程: HTML教程 CSS教程 JavaScript教程 Go语言教程 JQuery教程 VUE教程 VUE3教程 Bootstrap教程 SQL数据库教程 C语言教程 C++教程 Java教程 Python教程 Python3教程 C#教程
数码: 电脑笔记本显卡显示器固态硬盘硬盘耳机手机 iphone vivo oppo 小米华为单反装机图拉丁

-> 开发测试 -> vb6 PostMan接口测试 Ajax请求 HttpRequest -> 正文阅读

[开发测试]vb6 PostMan接口测试 Ajax请求 HttpRequest

?网络读卡器介绍：https://item.taobao.com/item.htm?spm=a1z10.5-c.w4002-17663462238.11.21915124bXuNyk&id=17021194999https://item.taobao.com/item.htm?spm=a1z10.5-c.w4002-17663462238.11.21915124bXuNyk&id=17021194999

Private Declare Function MyMD5 Lib "PayApiFun.dll" (ByVal inputstr As String, ByRef outinf As Any) As Integer
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Sub Command1_Click()
Dim outinf(500) As Byte
resul = MyMD5(Trim(Text1.Text), VarPtr(outinf(0)))
If resul = 0 Then
    Text4.Text = MidB(StrConv(outinf, vbUnicode), 1, 500)
End If
End Sub

Private Sub Command2_Click()
If Trim(Text2.Text) = "" Then MsgBox "请输入需POST的字符!", vbCritical + vbOKOnly, "提示": Exit Sub
Url = Trim(Text10.Text)
Text4.Text = Ajax_Post(Url, Trim(Text2.Text), 1)
End Sub

Private Sub Command3_Click()
If Trim(Text2.Text) = "" Then MsgBox "请输入需POST的字符!", vbCritical + vbOKOnly, "提示": Exit Sub
Url = Trim(Text3.Text)
Text4.Text = Ajax_Post(Url, Trim(Text2.Text), 1)
End Sub

Private Sub Command4_Click()
Dim Url As String, Key As Variant, JsonKey As String, timestamp As String, sign As String
Dim outinf(500) As Byte
Text4.Text = ""

timestamp = DateDiff("s", "1970-1-1 0:0:0", DateAdd("h", -8, Now)) & Right(timeGetTime, 3)
Key = Array("type=" & Trim(Text5.Text), "card=" & Trim(Text6.Text), "operator=" & Trim(Text7.Text), "timestamp=" & timestamp, "key=" & Trim(Text8.Text), "secret=" & Trim(Text9.Text))
JsonKey = Join(Key, "&")
Text1.Text = JsonKey

resul = MyMD5(JsonKey, VarPtr(outinf(0)))
If resul = 0 Then
    sign = MidB(StrConv(outinf, vbUnicode), 1, 500)
    Key = Array("type=" & Trim(Text5.Text), "card=" & Trim(Text6.Text), "operator=" & Trim(Text7.Text), "timestamp=" & timestamp, "key=" & Trim(Text8.Text), "sign=" & sign)
    JsonKey = Join(Key, "&")
    Text2.Text = JsonKey
    Url = Trim(Text3.Text)
    
    If Option1.Value = True Then
        Text4.Text = Ajax_Post(Url, Trim(Text2.Text), 1)
    Else
        Text4.Text = Win_HttpRequest_Post(Url, JsonKey, 1)
    End If
End If
    
End Sub

Private Sub Command5_Click()
Dim Url As String, Key As Variant, JsonKey As String, timestamp As String, sign As String
Dim outinf(500) As Byte
Text4.Text = ""

timestamp = DateDiff("s", "1970-1-1 0:0:0", DateAdd("h", -8, Now)) & Right(timeGetTime, 3)
Key = Array("type=" & Trim(Text5.Text), "formerCard=" & Trim(Text11.Text), "newCard=" & Trim(Text12.Text), "operator=" & Trim(Text7.Text), "timestamp=" & timestamp, "key=" & Trim(Text8.Text), "secret=" & Trim(Text9.Text))
JsonKey = Join(Key, "&")
Text1.Text = JsonKey

resul = MyMD5(JsonKey, VarPtr(outinf(0)))
If resul = 0 Then
    sign = MidB(StrConv(outinf, vbUnicode), 1, 500)
    Key = Array("type=" & Trim(Text5.Text), "formerCard=" & Trim(Text11.Text), "newCard=" & Trim(Text12.Text), "operator=" & Trim(Text7.Text), "timestamp=" & timestamp, "key=" & Trim(Text8.Text), "sign=" & sign)
    JsonKey = Join(Key, "&")
    Text2.Text = JsonKey
    Url = Trim(Text10.Text)
    
    If Option1.Value = True Then
        Text4.Text = Ajax_Post(Url, Trim(Text2.Text), 1)
    Else
        Text4.Text = Win_HttpRequest_Post(Url, JsonKey, 1)
    End If

End If
End Sub


Private Sub Command6_Click()
Dim Url As String, Key As Variant, JsonKey As String, timestamp As String, sign As String
Dim outinf(500) As Byte
Text4.Text = ""

If Trim(Text14.Text) = "" Then
    MsgBox "请输入唯一的msgId", vbCritical + vbOKOnly, "提示"
    Text14.SetFocus
    Exit Sub
End If

timestamp = DateDiff("s", "1970-1-1 0:0:0", DateAdd("h", -8, Now)) & Right(timeGetTime, 3)
Key = Array("msgId=" & Trim(Text14.Text), "ic=" & Trim(Text6.Text), "place=" & Trim(Text15.Text), "price=" & Trim(Text16.Text), "type=" & Trim(Text5.Text), "date=" & Format(Now, "YYYY-MM-DD"), "time=" & Format(Now, "HH:MM:SS"), "timestamp=" & timestamp, "key=" & Trim(Text8.Text), "secret=" & Trim(Text9.Text))
JsonKey = Join(Key, "&")
Text1.Text = JsonKey

resul = MyMD5(JsonKey, VarPtr(outinf(0)))
If resul = 0 Then
    sign = MidB(StrConv(outinf, vbUnicode), 1, 500)
    Key = Array("msgId=" & Trim(Text14.Text), "ic=" & Trim(Text6.Text), "place=" & Trim(Text15.Text), "price=" & Trim(Text16.Text), "type=" & Trim(Text5.Text), "date=" & Format(Now, "YYYY-MM-DD"), "time=" & Format(Now, "HH:MM:SS"), "timestamp=" & timestamp, "key=" & Trim(Text8.Text), "sign=" & sign)
    JsonKey = Join(Key, "&")
    Text2.Text = JsonKey
    Url = Trim(Text13.Text)
    Text4.Text = Win_HttpRequest_Post(Url, JsonKey, 1)
End If
End Sub



Public Function Win_HttpRequest_Post(ByVal StrUrl As String, ByVal StrData As String, Optional ByVal Index As Long) As Variant
Dim aHttpRequest        As WinHttp.WinHttpRequest
Dim sUrl                As String
Dim sMethod             As String
Dim sBody               As String
Dim sResponse           As String
Dim S As String, B() As Byte
 
On Error GoTo MyError:

sUrl = StrUrl
sBody = StrData
sMethod = "POST"

Set aHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")

aHttpRequest.Open sMethod, sUrl, True

aHttpRequest.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
aHttpRequest.SetRequestHeader "Content-Length", Len(sBody)
aHttpRequest.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
aHttpRequest.SetRequestHeader "Connection", "Keep-Alive"
aHttpRequest.Send sBody
aHttpRequest.WaitForResponse

Select Case Index
        Case 1: S = aHttpRequest.ResponseText: Win_HttpRequest_Post = S             '返回字符串
        Case 2: B = aHttpRequest.ResponseBody: Win_HttpRequest_Post = B             '返回二进制
        Case 3: S = BytesToStr(aHttpRequest.ResponseBody): Win_HttpRequest_Post = S '二进制转字符串[直接返回字串出现乱码时尝试]
        Case Else: Win_HttpRequest_Post = vbNullString '无效的返回
End Select
    
Set aHttpRequest = Nothing
Exit Function
MyError:
    Win_HttpRequest_Post = "HttpRequest请求异常，错误编号：" & Err.Number & " ，错误描述：" & Err.Description '出错返回空
End Function

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 = "HttpRequest请求异常，错误编号：" & Err.Number & " ，错误描述：" & Err.Description '出错返回空
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