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

主要模块代码如下：

'==========================================================

'| 模 块 名 | 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