vb6 PostMan接口测试 Ajax请求 HttpRequest

原创

津津有味0202 2022-04-08 18:02:01 博主文章分类：网络读卡器 ©著作权

文章标签 vb6 Post vb6 ajax VB6 http vb6 时间戳 Vb6 Md5 文章分类 代码人生

©著作权归作者所有：来自51CTO博客作者津津有味0202的原创作品，请联系作者获取转载授权，否则将追究法律责任

vb6 PostMan接口测试 Ajax请求 HttpRequest_Vb6 Md5

网络读卡器介绍：https://item.taobao.com/item.htm?spm=a1z10.5-c.w4002-17663462238.11.21915124bXuNyk&id=17021194999 vb6 PostMan接口测试 Ajax请求 HttpRequest_Vb6 Md5_02 https://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