VB使用XMLHTTP实现Post与Get的方法

技术  /  管理员 发布于 7年前   207

本文所述为visual basic6.0的一个模块方法，是使用XMLHTTP实现Post与Get功能，虽然是一个老代码，但是可以替代Inet控件，实现数据通讯。很值得学习借鉴一下。

主要模块代码如下：

'=========================================================='| 模 块 名 | XMLHTTP'| 说  明 | 替代Inet控件，实现数据通讯'==========================================================Public Enum DataEnum  ResponseText = 1  ResponseBody = 2End Enum Public Function GetData(ByVal Url As String, ByVal DataStic As DataEnum) As Variant    On Error GoTo ERR:  Dim XMLHTTP As Object  Dim DataS As String  Dim DataB() As Byte    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")    XMLHTTP.Open "get", Url, True  XMLHTTP.send    While XMLHTTP.ReadyState <> 4    DoEvents  Wend  '--------------------------------------函数返回  Select Case DataStic  Case ResponseText    '--------------------------------直接返回字符串    DataS = XMLHTTP.ResponseText    GetData = DataS  Case ResponseBody    '--------------------------------直接返回二进制    DataB = XMLHTTP.ResponseBody    GetData = DataB  Case ResponseBody + ResponseText    '------------------------------二进制转字符串[直接返回字串出现乱码时尝试]    DataS = BytesToStr(XMLHTTP.ResponseBody)    GetData = DataS  Case Else    '--------------------------------无效的返回    GetData = ""  End Select  '--------------------------------------释放空间  Set XMLHTTP = Nothing  Exit FunctionERR:  GetData = ""End Function Public Function PostData(ByVal StrUrl As String, ByVal StrData As String, ByVal DataStic As DataEnum) As Variant  On Error GoTo ERR:    Dim XMLHTTP As Object  Dim DataS As String  Dim DataB() As Byte    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")    XMLHTTP.Open "POST", StrUrl, True  XMLHTTP.setRequestHeader "Content-Length", Len(PostData)  XMLHTTP.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"  XMLHTTP.send (StrData)    Do Until XMLHTTP.ReadyState = 4    DoEvents  Loop  '-----------------------------函数返回  Select Case DataStic  Case ResponseText    '--------------------------------直接返回字符串    DataS = XMLHTTP.ResponseText    PostData = DataS  Case ResponseBody    '--------------------------------直接返回二进制    DataB = XMLHTTP.ResponseBody    PostData = DataB  Case ResponseBody + ResponseText    '---------------------------二进制转字符串[直接返回字串出现乱码时尝试]    DataS = BytesToStr(XMLHTTP.ResponseBody)    PostData = DataS  Case Else    '--------------------------------无效的返回    PostData = ""  End Select  '------------------------------------释放空间  Set XMLHTTP = Nothing  Exit FunctionERR:  PostData = ""End Function Function BytesToStr(ByVal vIn) As String  strReturn = ""  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 = strReturnEnd Function