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                 Using sr As StreamReader = New StreamReader(res.GetResponseStream)
 173                     contentText = sr.ReadToEnd()
 174                 End Using
 175                 Return res.StatusCode
 176             End If
 177             Throw ex
 178         End Try
 179     End Function
 180
 181     '''<summary>
 182     '''HTTPの応答を処理します。応答ボディデータが不要な用途向け。
 183     '''</summary>
 184     '''<remarks>
 185     '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
 186     '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
 187     '''</remarks>
 188     '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
 189     '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
 190     '''<param name="withCookie">通信にcookieを使用する</param>
 191     '''<returns>HTTP応答のステータスコード</returns>
 192     Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
 193                                         ByVal headerInfo As Dictionary(Of String, String), _
 194                                         ByVal withCookie As Boolean _
 195                                     ) As HttpStatusCode
 196         Try
 197             Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
 198                 Dim statusCode As HttpStatusCode = webRes.StatusCode
 199                 'cookie保持
 200                 If withCookie Then SaveCookie(webRes.Cookies)
 201                 'リダイレクト応答の場合は、リダイレクト先を設定
 202                 GetHeaderInfo(webRes, headerInfo)
 203                 Return statusCode
 204             End Using
 205         Catch ex As WebException
 206             If ex.Status = WebExceptionStatus.ProtocolError Then
 207                 Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
 208                 Return res.StatusCode
 209             End If
 210             Throw ex
 211         End Try
 212     End Function
 213
 214     '''<summary>
 215     '''HTTPの応答を処理し、応答ボディデータをBitmapとして返却します
 216     '''</summary>
 217     '''<remarks>
 218     '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
 219     '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
 220     '''</remarks>
 221     '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
 222     '''<param name="contentText">[OUT]HTTP応答のボディデータを書き込むBitmap</param>
 223     '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
 224     '''<param name="withCookie">通信にcookieを使用する</param>
 225     '''<returns>HTTP応答のステータスコード</returns>
 226     Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
 227                                         ByRef contentBitmap As Bitmap, _
 228                                         ByVal headerInfo As Dictionary(Of String, String), _
 229                                         ByVal withCookie As Boolean _
 230                                     ) As HttpStatusCode
 231         Try
 232             Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
 233                 Dim statusCode As HttpStatusCode = webRes.StatusCode
 234                 'cookie保持
 235                 If withCookie Then SaveCookie(webRes.Cookies)
 236                 'リダイレクト応答の場合は、リダイレクト先を設定
 237                 GetHeaderInfo(webRes, headerInfo)
 238                 '応答のストリームをBitmapにして戻す
 239                 'If webRes.ContentLength > 0 Then contentBitmap = New Bitmap(webRes.GetResponseStream)
 240                 contentBitmap = New Bitmap(webRes.GetResponseStream)
 241                 Return statusCode
 242             End Using
 243         Catch ex As WebException
 244             If ex.Status = WebExceptionStatus.ProtocolError Then
 245                 Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
 246                 Return res.StatusCode
 247             End If
 248             Throw ex
 249         End Try
 250     End Function
 251
 252     '''<summary>
 253     '''クッキーを保存。ホスト名なしのドメインの場合、ドメイン名から先頭のドットを除去して追加しないと再利用されないため
 254     '''</summary>
 255     Private Sub SaveCookie(ByVal cookieCollection As CookieCollection)
 256         For Each ck As Cookie In cookieCollection
 257             If ck.Domain.StartsWith(".") Then
 258                 ck.Domain = ck.Domain.Substring(1, ck.Domain.Length - 1)
 259                 cookieContainer.Add(ck)
 260             End If
 261         Next
 262     End Sub
 263
 264     '''<summary>
 265     '''in/outのストリームインスタンスを受け取り、コピーして返却
 266     '''</summary>
 267     '''<param name="inStream">コピー元ストリームインスタンス。読み取り可であること</param>
 268     '''<param name="outStream">コピー先ストリームインスタンス。書き込み可であること</param>
 269     Private Sub CopyStream(ByVal inStream As Stream, ByVal outStream As Stream)
 270         If inStream Is Nothing Then Throw New ArgumentNullException("inStream")
 271         If outStream Is Nothing Then Throw New ArgumentNullException("outStream")
 272         If Not inStream.CanRead Then Throw New ArgumentException("Input stream can not read.")
 273         If Not outStream.CanWrite Then Throw New ArgumentException("Output stream can not write.")
 274         If inStream.CanSeek AndAlso inStream.Length = 0 Then Throw New ArgumentException("Input stream do not have data.")
 275
 276         Do
 277             Dim buffer(1024) As Byte
 278             Dim i As Integer = buffer.Length
 279             i = inStream.Read(buffer, 0, i)
 280             If i = 0 Then Exit Do
 281             outStream.Write(buffer, 0, i)
 282         Loop
 283     End Sub
 284
 285     '''<summary>
 286     '''headerInfoのキー情報で指定されたHTTPヘッダ情報を取得・格納する。redirect応答時はLocationヘッダの内容を追記する
 287     '''</summary>
 288     '''<param name="webResponse">HTTP応答</param>
 289     '''<param name="headerInfo">[IN/OUT]キーにヘッダ名を指定したデータ空のコレクション。取得した値をデータにセットして戻す</param>
 290     Private Sub GetHeaderInfo(ByVal webResponse As HttpWebResponse, _
 291                                     ByVal headerInfo As Dictionary(Of String, String))
 292
 293         If headerInfo Is Nothing Then Exit Sub
 294
 295         If headerInfo.Count > 0 Then
 296             Dim keys(headerInfo.Count - 1) As String
 297             headerInfo.Keys.CopyTo(keys, 0)
 298             For Each key As String In keys
 299                 If Array.IndexOf(webResponse.Headers.AllKeys, key) > -1 Then
 300                     headerInfo.Item(key) = webResponse.Headers.Item(key)
 301                 Else
 302                     headerInfo.Item(key) = ""
 303                 End If
 304             Next
 305         End If
 306
 307         Dim statusCode As HttpStatusCode = webResponse.StatusCode
 308         If statusCode = HttpStatusCode.MovedPermanently OrElse _
 309            statusCode = HttpStatusCode.Found OrElse _
 310            statusCode = HttpStatusCode.SeeOther OrElse _
 311            statusCode = HttpStatusCode.TemporaryRedirect Then
 312             If headerInfo.ContainsKey("Location") Then
 313                 headerInfo.Item("Location") = webResponse.Headers.Item("Location")
 314             Else
 315                 headerInfo.Add("Location", webResponse.Headers.Item("Location"))
 316             End If
 317         End If
 318     End Sub
 319
 320     '''<summary>
 321     '''クエリコレクションをkey=value形式の文字列に構成して戻す
 322     '''</summary>
 323     '''<param name="param">クエリ、またはポストデータとなるkey-valueコレクション</param>
 324     Protected Function CreateQueryString(ByVal param As IDictionary(Of String, String)) As String
 325         If param Is Nothing OrElse param.Count = 0 Then Return String.Empty
 326
 327         Dim query As New StringBuilder
 328         For Each key As String In param.Keys
 329             query.AppendFormat("{0}={1}&", UrlEncode(key), UrlEncode(param(key)))
 330         Next
 331         Return query.ToString(0, query.Length - 1)
 332     End Function
 333
 334     '''<summary>
 335     '''クエリ形式（key1=value1&key2=value2&...）の文字列をkey-valueコレクションに詰め直し
 336     '''</summary>
 337     '''<param name="queryString">クエリ文字列</param>
 338     '''<returns>key-valueのコレクション</returns>
 339     Protected Function ParseQueryString(ByVal queryString As String) As NameValueCollection
 340         Dim query As New NameValueCollection
 341         Dim parts() As String = queryString.Split("&"c)
 342         For Each part As String In parts
 343             Dim index As Integer = part.IndexOf("="c)
 344             If index = -1 Then
 345                 query.Add(Uri.UnescapeDataString(part), "")
 346             Else
 347                 query.Add(Uri.UnescapeDataString(part.Substring(0, index)), Uri.UnescapeDataString(part.Substring(index + 1)))
 348             End If
 349         Next
 350         Return query
 351     End Function
 352
 353     '''<summary>
 354     '''2バイト文字も考慮したUrlエンコード
 355     '''</summary>
 356     '''<param name="str">エンコードする文字列</param>
 357     '''<returns>エンコード結果文字列</returns>
 358     Protected Function UrlEncode(ByVal stringToEncode As String) As String
 359         Const UnreservedChars As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~"
 360         Dim sb As New StringBuilder
 361         Dim bytes As Byte() = Encoding.UTF8.GetBytes(stringToEncode)
 362
 363         For Each b As Byte In bytes
 364             If UnreservedChars.IndexOf(Chr(b)) <> -1 Then
 365                 sb.Append(Chr(b))
 366             Else
 367                 sb.AppendFormat("%{0:X2}", b)
 368             End If
 369         Next
 370         Return sb.ToString()
 371     End Function
 372
 373 #Region "DefaultTimeout"
 374     '''<summary>
 375     '''通信タイムアウト時間（ms）
 376     '''</summary>
 377     Private Shared timeout As Integer = 20000
 378
 379     '''<summary>
 380     '''通信タイムアウト時間（ms）。10～120秒の範囲で指定。範囲外は20秒とする
 381     '''</summary>
 382     Protected Shared Property DefaultTimeout() As Integer
 383         Get
 384             Return timeout
 385         End Get
 386         Set(ByVal value As Integer)
 387             Const TimeoutMinValue As Integer = 10000
 388             Const TimeoutMaxValue As Integer = 120000
 389             Const TimeoutDefaultValue As Integer = 20000
 390             If value < TimeoutMinValue OrElse value > TimeoutMaxValue Then
 391                 ' 範囲外ならデフォルト値設定
 392                 timeout = TimeoutDefaultValue
 393             Else
 394                 timeout = value
 395             End If
 396         End Set
 397     End Property
 398 #End Region
 399
 400     '''<summary>
 401     '''通信クラスの初期化処理。タイムアウト値とプロキシを設定する
 402     '''</summary>
 403     '''<remarks>
 404     '''通信開始前に最低一度呼び出すこと
 405     '''</remarks>
 406     '''<param name="timeout">タイムアウト値（秒）</param>
 407     '''<param name="proxyType">なし・指定・IEデフォルト</param>
 408     '''<param name="proxyAddress">プロキシのホスト名orIPアドレス</param>
 409     '''<param name="proxyPort">プロキシのポート番号</param>
 410     '''<param name="proxyUser">プロキシ認証が必要な場合のユーザ名。不要なら空文字</param>
 411     '''<param name="proxyPassword">プロキシ認証が必要な場合のパスワード。不要なら空文字</param>
 412     Public Shared Sub InitializeConnection( _
 413             ByVal timeout As Integer, _
 414             ByVal proxyType As ProxyType, _
 415             ByVal proxyAddress As String, _
 416             ByVal proxyPort As Integer, _
 417             ByVal proxyUser As String, _
 418             ByVal proxyPassword As String)
 419         isInitialize = True
 420         ServicePointManager.Expect100Continue = False
 421         DefaultTimeout = timeout * 1000     's -> ms
 422         Select Case proxyType
 423             Case proxyType.None
 424                 proxy = Nothing
 425             Case proxyType.Specified
 426                 proxy = New WebProxy("http://" + proxyAddress + ":" + proxyPort.ToString)
 427                 If Not String.IsNullOrEmpty(proxyUser) OrElse Not String.IsNullOrEmpty(proxyPassword) Then
 428                     proxy.Credentials = New NetworkCredential(proxyUser, proxyPassword)
 429                 End If
 430             Case proxyType.IE
 431                 'IE設定（システム設定）はデフォルト値なので処理しない
 432         End Select
 433         proxyKind = proxyType
 434     End Sub
 435
 436 End Class