本文所述為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(Midbode) + 1, 1)) strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) i = i + 1 End If Next BytesToStr = strReturnEnd Function