vb6 PostMan接口测试 Ajax请求 HttpRequest

津津有味道

已于 2022-04-08 18:02:01 修改

阅读量1k

点赞数

于 2022-04-08 17:51:14 首次发布

本文链接：https://blog.csdn.net/zhangjin7422/article/details/124047027

版权

网络读卡器专栏收录该内容

47 篇文章 0 订阅

订阅专栏

网络读卡器介绍：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