'入力 '　strHost　ホスト名 '　strPort　ポート番号 '　strRequest　リクエスト情報 '出力 '　aryHeader　ヘッダー情報 '　aryBody　ボディ情報 '戻り値 '　True サーバへの接続成功 '　False サーバへの接続失敗 Function HttpGet(strHost, strPort, strRequest, aryHeader, aryBody) 　　Dim objSocket, aryLine, lngN 　　Dim aryH, aryB 　　' 戻り値、出力を初期化 　　HttpGet = False 　　aryH = array() 　　aryB = array() 　　Err = 0 　　' ソケットを作成 　　Set objSocket = Server.CreateObject("Socket.TCP") 　　objSocket.Host = strHost 　　objSocket.Port = strPort 　　objSocket.Timeout = 5000 　　On Error Resume Next 　　objSocket.Open 　　If Err = 0 Then 　　　　If objSocket.Connected Then 　　　　　　' リクエスト送信 　　　　　　objSocket.SendLine strRequest 　　　　　　objSocket.SendLine "" 　　　　　　' レスポンス受信 　　　　　　objSocket.WaitForDisconnect 　　　　　　' ヘッダーとボディに分割する 　　　　　　lngN = InStr(objSocket.Buffer, vbCrLf & vbCrLf) 　　　　　　if lngN < 0 Then 　　　　　　　　aryH = Split(objSocket.Buffer, vbCrLf) 　　　　　　　　aryB = Array() 　　　　　　Else 　　　　　　　　aryH = Split(Left(objSocket.Buffer, lngN - 1), vbCrLf) 　　　　　　　　aryB = Split(Mid(objSocket.Buffer, lngN + 4), vbCrLf) 　　　　　　End If 　　　　　　' ソケットを閉じる 　　　　　　objSocket.Close 　　　　　　HttpGet = True 　　　　End If 　　End If 　　Set objSocket = Nothing 　　If Not IsNull(aryHeader) Then 　　　　aryHeader = aryH 　　End If 　　If Not IsNull(aryBody) Then 　　　　aryBody = aryB 　　End If End Function

If HttpGet(strHost, strPort, _ 　　　　"OPTIONS * HTTP/1.0", aryHeader, aryBody) Then 　　　　For lngN = 0 To UBound(aryHeader) 　　　　　　strLine = aryHeader(lngN) 　　　　　　If InStr(strLine, "Server:") = 1 Then 　　　　　　　　strResult = Mid(strLine, Len("Server: ") + 1) 　　　　　　　　Exit For 　　　　　　End If 　　　　Next 　　　　If strResult = "" Then 　　　　　　If HttpGet(strHost, strPort, _ 　　　　　　　　"GET / HTTP/1.0", aryHeader, aryBody) Then 　　　　　　　　For lngN = 0 To UBound(aryHeader) 　　　　　　　　　　strLine = aryHeader(lngN) 　　　　　　　　　　If InStr(strLine, "Server:") = 1 Then 　　　　　　　　　　　　strResult = Mid(strLine, Len("Server: ") + 1) 　　　　　　　　　　　　Exit For 　　　　　　　　　　End If 　　　　　　　　Next 　　　　　　End If 　　　　End If 　　Else 　　　　strResult = "サーバにアクセスできませんでした" 　　End If