VB使用XMLHTTP实现Post与Get的方法
本文所述为visualbasic6.0的一个模块方法，是使用XMLHTTP实现Post与Get功能，虽然是一个老代码，但是可以替代Inet控件，实现数据通讯。很值得学习借鉴一下。
主要模块代码如下：
'==========================================================
'|模块名|XMLHTTP
'|说明|替代Inet控件，实现数据通讯
'==========================================================PublicEnumDataEnum
ResponseText=1
ResponseBody=2
EndEnum
PublicFunctionGetData(ByValUrlAsString,ByValDataSticAsDataEnum)AsVariant
OnErrorGoToERR:
DimXMLHTTPAsObject
DimDataSAsString
DimDataB()AsByte
SetXMLHTTP=CreateObject("Microsoft.XMLHTTP")
XMLHTTP.Open"get",Url,True
XMLHTTP.send
WhileXMLHTTP.ReadyState<>4
DoEvents
Wend
'--------------------------------------函数返回
SelectCaseDataStic
CaseResponseText
'--------------------------------直接返回字符串
DataS=XMLHTTP.ResponseText
GetData=DataS
CaseResponseBody
'--------------------------------直接返回二进制
DataB=XMLHTTP.ResponseBody
GetData=DataB
CaseResponseBody+ResponseText
'------------------------------二进制转字符串[直接返回字串出现乱码时尝试]
DataS=BytesToStr(XMLHTTP.ResponseBody)
GetData=DataS
CaseElse
'--------------------------------无效的返回
GetData=""
EndSelect
'--------------------------------------释放空间
SetXMLHTTP=Nothing
ExitFunction
ERR:
GetData=""
EndFunction
PublicFunctionPostData(ByValStrUrlAsString,ByValStrDataAsString,ByValDataSticAsDataEnum)AsVariant
OnErrorGoToERR:
DimXMLHTTPAsObject
DimDataSAsString
DimDataB()AsByte
SetXMLHTTP=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)
DoUntilXMLHTTP.ReadyState=4
DoEvents
Loop
'-----------------------------函数返回
SelectCaseDataStic
CaseResponseText
'--------------------------------直接返回字符串
DataS=XMLHTTP.ResponseText
PostData=DataS
CaseResponseBody
'--------------------------------直接返回二进制
DataB=XMLHTTP.ResponseBody
PostData=DataB
CaseResponseBody+ResponseText
'---------------------------二进制转字符串[直接返回字串出现乱码时尝试]
DataS=BytesToStr(XMLHTTP.ResponseBody)
PostData=DataS
CaseElse
'--------------------------------无效的返回
PostData=""
EndSelect
'------------------------------------释放空间
SetXMLHTTP=Nothing
ExitFunction
ERR:
PostData=""
EndFunction
FunctionBytesToStr(ByValvIn)AsString
strReturn=""
Fori=1ToLenB(vIn)
ThisCharCode=AscB(MidB(vIn,i,1))
IfThisCharCode<&H80Then
strReturn=strReturn&Chr(ThisCharCode)
Else
NextCharCode=AscB(MidB(vIn,i+1,1))
strReturn=strReturn&Chr(CLng(ThisCharCode)*&H100+CInt(NextCharCode))
i=i+1
EndIf
Next
BytesToStr=strReturn
EndFunction