vb6.0微信支付

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