Tween/Connection/HttpConnection.vb

   1 Imports System.Net
   2 Imports System.IO
   3 Imports System.Collections.Generic
   4 Imports System.Collections.Specialized
   5 Imports System.Text
   6
   7 '''<summary>
   8 '''HttpWebRequest,HttpWebResponseを使用した基本的な通信機能を提供する
   9 '''</summary>
  10 '''<remarks>
  11 '''プロキシ情報などを設定するため、使用前に静的メソッドInitializeConnectionを呼び出すこと。
  12 '''通信方式によって必要になるHTTPヘッダの付加などは、派生クラスで行う。
  13 '''</remarks>
  14 Public Class HttpConnection
  15     '''<summary>
  16     '''プロキシ
  17     '''</summary>
  18     Private Shared proxy As WebProxy = Nothing
  19
  20     '''<summary>
  21     '''ユーザーが選択したプロキシの方式
  22     '''</summary>
  23     Private Shared proxyKind As ProxyType = proxyType.IE
  24
  25     '''<summary>
  26     '''クッキー保存用コンテナ
  27     '''</summary>
  28     Private Shared cookieContainer As New CookieContainer
  29
  30     '''<summary>
  31     '''初期化済みフラグ
  32     '''</summary>
  33     Private Shared isInitialize As Boolean = False
  34
  35     Public Enum ProxyType
  36         None
  37         IE
  38         Specified
  39     End Enum
  40
  41     '''<summary>
  42     '''HttpWebRequestオブジェクトを取得する。パラメータはGET/HEAD/DELETEではクエリに、POST/PUTではエンティティボディに変換される。
  43     '''</summary>
  44     '''<remarks>
  45     '''追加で必要となるHTTPヘッダや通信オプションは呼び出し元で付加すること
  46     '''（Timeout,AutomaticDecompression,AllowAutoRedirect,UserAgent,ContentType,Accept,HttpRequestHeader.Authorization,カスタムヘッダ）
  47     '''POST/PUTでクエリが必要な場合は、requestUriに含めること。
  48     '''</remarks>
  49     '''<param name="method">HTTP通信メソッド（GET/HEAD/POST/PUT/DELETE）</param>
  50     '''<param name="requestUri">通信先URI</param>
  51     '''<param name="param">GET時のクエリ、またはPOST時のエンティティボディ</param>
  52     '''<param name="withCookie">通信にcookieを使用するか</param>
  53     '''<returns>引数で指定された内容を反映したHttpWebRequestオブジェクト</returns>
  54     Protected Function CreateRequest(ByVal method As String, _
  55                                             ByVal requestUri As Uri, _
  56                                             ByVal param As Dictionary(Of String, String), _
  57                                             ByVal withCookie As Boolean _
  58                                         ) As HttpWebRequest
  59         If Not isInitialize Then Throw New Exception("Sequence error.(not initialized)")
  60
  61         'GETメソッドの場合はクエリとurlを結合
  62         Dim ub As New UriBuilder(requestUri.AbsoluteUri)
  63         If param IsNot Nothing AndAlso (method = "GET" OrElse method = "DELETE" OrElse method = "HEAD") Then
  64             ub.Query = CreateQueryString(param)
  65         End If
  66
  67         Dim webReq As HttpWebRequest = DirectCast(WebRequest.Create(ub.Uri), HttpWebRequest)
  68
  69         'プロキシ設定
  70         If proxyKind <> ProxyType.IE Then webReq.Proxy = proxy
  71
  72         webReq.Method = method
  73         If method = "POST" OrElse method = "PUT" Then
  74             webReq.ContentType = "application/x-www-form-urlencoded"
  75             'POST/PUTメソッドの場合は、ボディデータとしてクエリ構成して書き込み
  76             Using writer As New StreamWriter(webReq.GetRequestStream)
  77                 writer.Write(CreateQueryString(param))
  78             End Using
  79         End If
  80         'cookie設定
  81         If withCookie Then webReq.CookieContainer = cookieContainer
  82         'タイムアウト設定
  83         webReq.Timeout = DefaultTimeout
  84
  85         Return webReq
  86     End Function
  87
  88     '''<summary>
  89     '''HTTPの応答を処理し、引数で指定されたストリームに書き込み
  90     '''</summary>
  91     '''<remarks>
  92     '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
  93     '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
  94     '''gzipファイルのダウンロードを想定しているため、他形式の場合は伸張時に問題が発生する可能性があります。
  95     '''</remarks>
  96     '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
  97     '''<param name="contentStream">[OUT]HTTP応答のボディストリームのコピー先</param>
  98     '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
  99     '''<param name="withCookie">通信にcookieを使用する</param>
 100     '''<returns>HTTP応答のステータスコード</returns>
 101     Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
 102                                         ByVal contentStream As Stream, _
 103                                         ByVal headerInfo As Dictionary(Of String, String), _
 104                                         ByVal withCookie As Boolean _
 105                                     ) As HttpStatusCode
 106         Try
 107             Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
 108                 Dim statusCode As HttpStatusCode = webRes.StatusCode
 109                 'cookie保持
 110                 If withCookie Then SaveCookie(webRes.Cookies)
 111                 'リダイレクト応答の場合は、リダイレクト先を設定
 112                 GetHeaderInfo(webRes, headerInfo)
 113                 '応答のストリームをコピーして戻す
 114                 If webRes.ContentLength > 0 Then
 115                     'gzipなら応答ストリームの内容は伸張済み。それ以外なら伸張する。
 116                     If webRes.ContentEncoding = "gzip" OrElse webRes.ContentEncoding = "deflate" Then
 117                         Using stream As Stream = webRes.GetResponseStream()
 118                             If stream IsNot Nothing Then CopyStream(stream, contentStream)
 119                         End Using
 120                     Else
 121                         Using stream As Stream = New System.IO.Compression.GZipStream(webRes.GetResponseStream, Compression.CompressionMode.Decompress)
 122                             If stream IsNot Nothing Then CopyStream(stream, contentStream)
 123                         End Using
 124                     End If
 125                 End If
 126                 Return statusCode
 127             End Using
 128         Catch ex As WebException
 129             If ex.Status = WebExceptionStatus.ProtocolError Then
 130                 Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
 131                 Return res.StatusCode
 132             End If
 133             Throw ex
 134         End Try
 135     End Function
 136
 137     '''<summary>
 138     '''HTTPの応答を処理し、応答ボディデータをテキストとして返却する
 139     '''</summary>
 140     '''<remarks>
 141     '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
 142     '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
 143     '''テキストの文字コードはUTF-8を前提として、エンコードはしていません
 144     '''</remarks>
 145     '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
 146     '''<param name="contentText">[OUT]HTTP応答のボディデータ</param>
 147     '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
 148     '''<param name="withCookie">通信にcookieを使用する</param>
 149     '''<returns>HTTP応答のステータスコード</returns>
 150     Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
 151                                         ByRef contentText As String, _
 152                                         ByVal headerInfo As Dictionary(Of String, String), _
 153                                         ByVal withCookie As Boolean _
 154                                     ) As HttpStatusCode
 155         Try
 156             Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
 157                 Dim statusCode As HttpStatusCode = webRes.StatusCode
 158                 'cookie保持
 159                 If withCookie Then SaveCookie(webRes.Cookies)
 160                 'リダイレクト応答の場合は、リダイレクト先を設定
 161                 GetHeaderInfo(webRes, headerInfo)
 162                 '応答のストリームをテキストに書き出し
 163                 If contentText Is Nothing Then Throw New ArgumentNullException("contentText")
 164                 Using sr As StreamReader = New StreamReader(webRes.GetResponseStream)
 165                     contentText = sr.ReadToEnd()
 166                 End Using
 167                 Return statusCode
 168             End Using
 169         Catch ex As WebException
 170             If ex.Status = WebExceptionStatus.ProtocolError Then
 171                 Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
 172                 Return res.StatusCode
 173             End If
 174             Throw ex
 175         End Try
 176     End Function
 177
 178     '''<summary>
 179     '''HTTPの応答を処理します。応答ボディデータが不要な用途向け。
 180     '''</summary>
 181     '''<remarks>
 182     '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
 183     '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
 184     '''</remarks>
 185     '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
 186     '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
 187     '''<param name="withCookie">通信にcookieを使用する</param>
 188     '''<returns>HTTP応答のステータスコード</returns>
 189     Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
 190                                         ByVal headerInfo As Dictionary(Of String, String), _
 191                                         ByVal withCookie As Boolean _
 192                                     ) As HttpStatusCode
 193         Try
 194             Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
 195                 Dim statusCode As HttpStatusCode = webRes.StatusCode
 196                 'cookie保持
 197                 If withCookie Then SaveCookie(webRes.Cookies)
 198                 'リダイレクト応答の場合は、リダイレクト先を設定
 199                 GetHeaderInfo(webRes, headerInfo)
 200                 Return statusCode
 201             End Using
 202         Catch ex As WebException
 203             If ex.Status = WebExceptionStatus.ProtocolError Then
 204                 Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
 205                 Return res.StatusCode
 206             End If
 207             Throw ex
 208         End Try
 209     End Function
 210
 211     '''<summary>
 212     '''HTTPの応答を処理し、応答ボディデータをBitmapとして返却します
 213     '''</summary>
 214     '''<remarks>
 215     '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
 216     '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
 217     '''</remarks>
 218     '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
 219     '''<param name="contentText">[OUT]HTTP応答のボディデータを書き込むBitmap</param>
 220     '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
 221     '''<param name="withCookie">通信にcookieを使用する</param>
 222     '''<returns>HTTP応答のステータスコード</returns>
 223     Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
 224                                         ByRef contentBitmap As Bitmap, _
 225                                         ByVal headerInfo As Dictionary(Of String, String), _
 226                                         ByVal withCookie As Boolean _
 227                                     ) As HttpStatusCode
 228         Try
 229             Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
 230                 Dim statusCode As HttpStatusCode = webRes.StatusCode
 231                 'cookie保持
 232                 If withCookie Then SaveCookie(webRes.Cookies)
 233                 'リダイレクト応答の場合は、リダイレクト先を設定
 234                 GetHeaderInfo(webRes, headerInfo)
 235                 '応答のストリームをBitmapにして戻す
 236                 'If webRes.ContentLength > 0 Then contentBitmap = New Bitmap(webRes.GetResponseStream)
 237                 contentBitmap = New Bitmap(webRes.GetResponseStream)
 238                 Return statusCode
 239             End Using
 240         Catch ex As WebException
 241             If ex.Status = WebExceptionStatus.ProtocolError Then
 242                 Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
 243                 Return res.StatusCode
 244             End If
 245             Throw ex
 246         End Try
 247     End Function
 248
 249     '''<summary>
 250     '''クッキーを保存。ホスト名なしのドメインの場合、ドメイン名から先頭のドットを除去して追加しないと再利用されないため
 251     '''</summary>
 252     Private Sub SaveCookie(ByVal cookieCollection As CookieCollection)
 253         For Each ck As Cookie In cookieCollection
 254             If ck.Domain.StartsWith(".") Then
 255                 ck.Domain = ck.Domain.Substring(1, ck.Domain.Length - 1)
 256                 cookieContainer.Add(ck)
 257             End If
 258         Next
 259     End Sub
 260
 261     '''<summary>
 262     '''in/outのストリームインスタンスを受け取り、コピーして返却
 263     '''</summary>
 264     '''<param name="inStream">コピー元ストリームインスタンス。読み取り可であること</param>
 265     '''<param name="outStream">コピー先ストリームインスタンス。書き込み可であること</param>
 266     Private Sub CopyStream(ByVal inStream As Stream, ByVal outStream As Stream)
 267         If inStream Is Nothing Then Throw New ArgumentNullException("inStream")
 268         If outStream Is Nothing Then Throw New ArgumentNullException("outStream")
 269         If Not inStream.CanRead Then Throw New ArgumentException("Input stream can not read.")
 270         If Not outStream.CanWrite Then Throw New ArgumentException("Output stream can not write.")
 271         If inStream.CanSeek AndAlso inStream.Length = 0 Then Throw New ArgumentException("Input stream do not have data.")
 272
 273         Do
 274             Dim buffer(1024) As Byte
 275             Dim i As Integer = buffer.Length
 276             i = inStream.Read(buffer, 0, i)
 277             If i = 0 Then Exit Do
 278             outStream.Write(buffer, 0, i)
 279         Loop
 280     End Sub
 281
 282     '''<summary>
 283     '''headerInfoのキー情報で指定されたHTTPヘッダ情報を取得・格納する。redirect応答時はLocationヘッダの内容を追記する
 284     '''</summary>
 285     '''<param name="webResponse">HTTP応答</param>
 286     '''<param name="headerInfo">[IN/OUT]キーにヘッダ名を指定したデータ空のコレクション。取得した値をデータにセットして戻す</param>
 287     Private Sub GetHeaderInfo(ByVal webResponse As HttpWebResponse, _
 288                                     ByVal headerInfo As Dictionary(Of String, String))
 289
 290         If headerInfo Is Nothing Then Exit Sub
 291
 292         If headerInfo.Count > 0 Then
 293             Dim keys(headerInfo.Count - 1) As String
 294             headerInfo.Keys.CopyTo(keys, 0)
 295             For Each key As String In keys
 296                 If Array.IndexOf(webResponse.Headers.AllKeys, key) > -1 Then
 297                     headerInfo.Item(key) = webResponse.Headers.Item(key)
 298                 Else
 299                     headerInfo.Item(key) = ""
 300                 End If
 301             Next
 302         End If
 303
 304         Dim statusCode As HttpStatusCode = webResponse.StatusCode
 305         If statusCode = HttpStatusCode.MovedPermanently OrElse _
 306            statusCode = HttpStatusCode.Found OrElse _
 307            statusCode = HttpStatusCode.SeeOther OrElse _
 308            statusCode = HttpStatusCode.TemporaryRedirect Then
 309             If headerInfo.ContainsKey("Location") Then
 310                 headerInfo.Item("Location") = webResponse.Headers.Item("Location")
 311             Else
 312                 headerInfo.Add("Location", webResponse.Headers.Item("Location"))
 313             End If
 314         End If
 315     End Sub
 316
 317     '''<summary>
 318     '''クエリコレクションをkey=value形式の文字列に構成して戻す
 319     '''</summary>
 320     '''<param name="param">クエリ、またはポストデータとなるkey-valueコレクション</param>
 321     Protected Function CreateQueryString(ByVal param As IDictionary(Of String, String)) As String
 322         If param Is Nothing OrElse param.Count = 0 Then Return String.Empty
 323
 324         Dim query As New StringBuilder
 325         For Each key As String In param.Keys
 326             query.AppendFormat("{0}={1}&", UrlEncode(key), UrlEncode(param(key)))
 327         Next
 328         Return query.ToString(0, query.Length - 1)
 329     End Function
 330
 331     '''<summary>
 332     '''クエリ形式（key1=value1&key2=value2&...）の文字列をkey-valueコレクションに詰め直し
 333     '''</summary>
 334     '''<param name="queryString">クエリ文字列</param>
 335     '''<returns>key-valueのコレクション</returns>
 336     Protected Function ParseQueryString(ByVal queryString As String) As NameValueCollection
 337         Dim query As New NameValueCollection
 338         Dim parts() As String = queryString.Split("&"c)
 339         For Each part As String In parts
 340             Dim index As Integer = part.IndexOf("="c)
 341             If index = -1 Then
 342                 query.Add(Uri.UnescapeDataString(part), "")
 343             Else
 344                 query.Add(Uri.UnescapeDataString(part.Substring(0, index)), Uri.UnescapeDataString(part.Substring(index + 1)))
 345             End If
 346         Next
 347         Return query
 348     End Function
 349
 350     '''<summary>
 351     '''2バイト文字も考慮したUrlエンコード
 352     '''</summary>
 353     '''<param name="str">エンコードする文字列</param>
 354     '''<returns>エンコード結果文字列</returns>
 355     Protected Function UrlEncode(ByVal stringToEncode As String) As String
 356         Const UnreservedChars As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~"
 357         Dim sb As New StringBuilder
 358         Dim bytes As Byte() = Encoding.UTF8.GetBytes(stringToEncode)
 359
 360         For Each b As Byte In bytes
 361             If UnreservedChars.IndexOf(Chr(b)) <> -1 Then
 362                 sb.Append(Chr(b))
 363             Else
 364                 sb.AppendFormat("%{0:X2}", b)
 365             End If
 366         Next
 367         Return sb.ToString()
 368     End Function
 369
 370 #Region "DefaultTimeout"
 371     '''<summary>
 372     '''通信タイムアウト時間（ms）
 373     '''</summary>
 374     Private Shared timeout As Integer = 20000
 375
 376     '''<summary>
 377     '''通信タイムアウト時間（ms）。10～120秒の範囲で指定。範囲外は20秒とする
 378     '''</summary>
 379     Protected Shared Property DefaultTimeout() As Integer
 380         Get
 381             Return timeout
 382         End Get
 383         Set(ByVal value As Integer)
 384             Const TimeoutMinValue As Integer = 10000
 385             Const TimeoutMaxValue As Integer = 120000
 386             Const TimeoutDefaultValue As Integer = 20000
 387             If value < TimeoutMinValue OrElse value > TimeoutMaxValue Then
 388                 ' 範囲外ならデフォルト値設定
 389                 timeout = TimeoutDefaultValue
 390             Else
 391                 timeout = value
 392             End If
 393         End Set
 394     End Property
 395 #End Region
 396
 397     '''<summary>
 398     '''通信クラスの初期化処理。タイムアウト値とプロキシを設定する
 399     '''</summary>
 400     '''<remarks>
 401     '''通信開始前に最低一度呼び出すこと
 402     '''</remarks>
 403     '''<param name="timeout">タイムアウト値（秒）</param>
 404     '''<param name="proxyType">なし・指定・IEデフォルト</param>
 405     '''<param name="proxyAddress">プロキシのホスト名orIPアドレス</param>
 406     '''<param name="proxyPort">プロキシのポート番号</param>
 407     '''<param name="proxyUser">プロキシ認証が必要な場合のユーザ名。不要なら空文字</param>
 408     '''<param name="proxyPassword">プロキシ認証が必要な場合のパスワード。不要なら空文字</param>
 409     Public Shared Sub InitializeConnection( _
 410             ByVal timeout As Integer, _
 411             ByVal proxyType As ProxyType, _
 412             ByVal proxyAddress As String, _
 413             ByVal proxyPort As Integer, _
 414             ByVal proxyUser As String, _
 415             ByVal proxyPassword As String)
 416         isInitialize = True
 417         ServicePointManager.Expect100Continue = False
 418         DefaultTimeout = timeout * 1000     's -> ms
 419         Select Case proxyType
 420             Case proxyType.None
 421                 proxy = Nothing
 422             Case proxyType.Specified
 423                 proxy = New WebProxy("http://" + proxyAddress + ":" + proxyPort.ToString)
 424                 If Not String.IsNullOrEmpty(proxyUser) OrElse Not String.IsNullOrEmpty(proxyPassword) Then
 425                     proxy.Credentials = New NetworkCredential(proxyUser, proxyPassword)
 426                 End If
 427             Case proxyType.IE
 428                 'IE設定（システム設定）はデフォルト値なので処理しない
 429         End Select
 430         proxyType = proxyType
 431     End Sub
 432
 433 End Class