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

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

    主要模块代码如下:

    
    '==========================================================
    '| 模 块 名 | XMLHTTP
    '| 说  明 | 替代Inet控件,实现数据通讯
    '==========================================================Public Enum DataEnum
      ResponseText = 1
      ResponseBody = 2
    End 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 Function
    ERR:
      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 Function
    ERR:
      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 = strReturn
    End Function