この記事では、XMLHTTP を使用して Post 関数と Get 関数を実装する Visual Basic6.0 のモジュール メソッドについて説明します。古いコードですが、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 = "" 終了選択 '------------------------------------------------------空間設定を解除XMLHTTP = なし 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()バイトセットとして 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 XMLHTTP.ReadyState = 4 まで DoEvents ループ '----------------------------関数は 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