root/lang/vb2005/Tween/trunk/Tween/Connection/HttpConnection.vb @ 35096

Revision 35096, 15.0 kB (checked in by kiri_feather, 4 years ago)

終了時設定保存タイミングを微調整
通信結果のコンテンツでテキストとビットマップを返却するメソッド追加

Line 
1Imports System.Net
2Imports System.IO
3Imports System.Collections.Generic
4Imports System.Collections.Specialized
5Imports System.Text
6
7'''<summary>
8'''HttpWebRequest,HttpWebResponse��p�������I�ȒʐM�@�\�������'''</summary>
9'''<remarks>
10'''�v���L�V���Ȃǂ�肷�邽�߁A�g�p�O�ɐÓI���\�b�hInitializeConnection��яo�����ƁB
11'''�ʐM�����ĕK�v�ɂȂ�TP�w�b�_�̕t��Ȃǂ́A�h���N���X��etContent���\�b�h��[�o�[���C�h���čs���B
12'''</remarks>
13Public Class HttpConnection
14    '''<summary>
15    '''�v���L�V
16    '''</summary>
17    Private Shared proxy As WebProxy = Nothing
18
19    '''<summary>
20    '''���[�U�[���I����v���L�V�̕�    '''</summary>
21    Private Shared proxyType As ProxyType = ProxyType.IE
22
23    '''<summary>
24    '''�N�b�L�[�ۑ��p�R���e�i
25    '''</summary>
26    Private Shared cookieContainer As New CookieContainer
27
28    '''<summary>
29    '''�����݃t���O
30    '''</summary>
31    Private Shared isInitialize As Boolean = False
32
33    '''<summary>
34    '''HTTP�ʐM�̃��\�b�h
35    '''</summary>
36    '''<remarks>
37    '''���̃��\�b�h�iHEAD,PUT,CONNECT�Ȃǁj���K�v�ȏꍇ�͒lj���邱��
38    '''</remarks>
39    Protected Enum RequestMethod
40        ReqGet
41        ReqPost
42    End Enum
43
44    '''<summary>
45    '''HttpWebRequest�I�u�W�F�N�g�������    '''</summary>
46    '''<remarks>
47    '''�K�v�ȃw�b�_�ނ͌Ăяo�����ŕt����邱��
48    '''�iTimeout,AutomaticDecompression,AllowAutoRedirect,UserAgent,ContentType,Accept,HttpRequestHeader.Authorization,�J�X�^���w�b�_�j
49    '''<param name="method">HTTP�ʐM���\�b�h�iGET/POST�Ȃǁj</param>
50    '''<param name="requestUri">�ʐM��I</param>
51    '''<param name="param">GET���̃N�G���A�܂���OST���̃{�f�B�f�[�^</param>
52    '''<param name="withCookie">�ʐM��ookie��p���邩</param>
53    '''<returns>���w�肳�ꂽ���𔽉f����HttpWebRequest�I�u�W�F�N�g</returns>
54    Protected Shared Function CreateRequest(ByVal method As RequestMethod, _
55                                            ByVal requestUri As Uri, _
56                                            ByVal param As SortedList(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���\�b�h�̏ꍇ�̓N�G����rl���
62        Dim ub As New UriBuilder(requestUri.AbsoluteUri)
63        If method = RequestMethod.ReqGet Then
64            ub.Query = CreateQueryString(param)
65        End If
66
67        Dim webReq As HttpWebRequest = DirectCast(WebRequest.Create(ub.Uri), HttpWebRequest)
68
69        '�v���L�V�ݒ�        If proxyType <> proxyType.IE Then webReq.Proxy = proxy
70
71        If method = RequestMethod.ReqGet Then
72            webReq.Method = "GET"
73        Else
74            webReq.Method = "POST"
75            webReq.ContentType = "application/x-www-form-urlencoded"
76            'POST���\�b�h�̏ꍇ�́A�{�f�B�f�[�^�Ƃ��ăN�G���\�����ď�������
77            Using writer As New StreamWriter(webReq.GetRequestStream)
78                writer.Write(CreateQueryString(param))
79            End Using
80        End If
81        'cookie�ݒ�        If withCookie Then webReq.CookieContainer = cookieContainer
82        '�^�C���A�E�g�ݒ�        webReq.Timeout = DefaultTimeout
83
84        Return webReq
85    End Function
86
87    '''<summary>
88    '''HTTP�̉���������A�X�g���[���̃R�s�[��p
89    '''</summary>
90    '''<remarks>
91    '''���_�C���N�g�����̏ꍇ�iAllowAutoRedirect=False�̏ꍇ�̂݁j�́AheaderInfo�C���X�^���X������Location�����ă��_�C���N�g���ԋp�B�{�f�B�f�[�^�͏������Ȃ��B
92    '''WebException�̓n���h�����Ă��Ȃ��̂ŁA�Ăяo�����ŃL���b�`���邱��
93    '''</remarks>
94    '''<param name="webRequest">HTTP�ʐM���N�G�X�g�I�u�W�F�N�g</param>
95    '''<param name="contentStream">[OUT]HTTP�����̃{�f�B�X�g���[���̃R�s�[�������ݗp</param>
96    '''<param name="headerInfo">[IN/OUT]HTTP�����̃w�b�_���B�w�b�_����[�ɂ��ċ�[�^�̃R���N�V����������ƂŁA�Y���̃w�b�_��[�^�ɐݒ肵�Ė߂�</param>
97    '''<param name="withCookie">�ʐM��ookie��p����param>
98    '''<returns>HTTP�����̃X�e�[�^�X�R�[�h</returns>
99    Protected Shared Function GetResponse(ByVal webRequest As HttpWebRequest, _
100                                        ByVal contentStream As Stream, _
101                                        ByVal headerInfo As Dictionary(Of String, String), _
102                                        ByVal withCookie As Boolean _
103                                    ) As HttpStatusCode
104        Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
105            Dim statusCode As HttpStatusCode = webRes.StatusCode
106            'cookie�ێ�
107            If withCookie Then SaveCookie(webRes.Cookies)
108            '���_�C���N�g�����̏ꍇ�́A���_�C���N�g���ݒ肵�ďI��
109            GetHeaderInfo(webRes, headerInfo)
110            '�����̃X�g���[����s�[���Ė߂�
111            If webRes.ContentLength > 0 Then
112                Using stream As Stream = webRes.GetResponseStream()
113                    If stream IsNot Nothing Then CopyStream(stream, contentStream)
114                End Using
115            End If
116            Return statusCode
117        End Using
118    End Function
119
120    Protected Shared Function GetResponse(ByVal webRequest As HttpWebRequest, _
121                                        ByRef contentText As String, _
122                                        ByVal headerInfo As Dictionary(Of String, String), _
123                                        ByVal withCookie As Boolean _
124                                    ) As HttpStatusCode
125        Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
126            Dim statusCode As HttpStatusCode = webRes.StatusCode
127            'cookie�ێ�
128            If withCookie Then SaveCookie(webRes.Cookies)
129            '���_�C���N�g�����̏ꍇ�́A���_�C���N�g���ݒ肵�ďI��
130            GetHeaderInfo(webRes, headerInfo)
131            '�����̃X�g���[����s�[���Ė߂�
132            If contentText Is Nothing Then Throw New ArgumentNullException("contentText")
133            If webRes.ContentLength > 0 Then
134                Using sr As StreamReader = New StreamReader(webRes.GetResponseStream)
135                    contentText = sr.ReadToEnd()
136                End Using
137            End If
138            Return statusCode
139        End Using
140    End Function
141
142    Protected Shared Function GetResponse(ByVal webRequest As HttpWebRequest, _
143                                        ByVal contentBitmap As Bitmap, _
144                                        ByVal headerInfo As Dictionary(Of String, String), _
145                                        ByVal withCookie As Boolean _
146                                    ) As HttpStatusCode
147        Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
148            Dim statusCode As HttpStatusCode = webRes.StatusCode
149            'cookie�ێ�
150            If withCookie Then SaveCookie(webRes.Cookies)
151            '���_�C���N�g�����̏ꍇ�́A���_�C���N�g���ݒ肵�ďI��
152            GetHeaderInfo(webRes, headerInfo)
153            '�����̃X�g���[����s�[���Ė߂�
154            If webRes.ContentLength > 0 Then contentBitmap = New Bitmap(webRes.GetResponseStream)
155            Return statusCode
156        End Using
157    End Function
158
159    Private Shared Sub SaveCookie(ByVal cookieCollection As CookieCollection)
160        For Each ck As Cookie In cookieCollection
161            If ck.Domain.StartsWith(".") Then
162                ck.Domain = ck.Domain.Substring(1, ck.Domain.Length - 1)
163                cookieContainer.Add(ck)
164            End If
165        Next
166    End Sub
167
168    '''<summary>
169    '''in/out�̃X�g���[���C���X�^���X������A�R�s�[���ĕԋp
170    '''</summary>
171    '''<param name="inStream">�R�s�[���X�g���[���C���X�^���X�B�ǂݎ��‚ł��邱��/param>
172    '''<param name="outStream">�R�s�[���g���[���C���X�^���X�B�������݉‚ł��邱��/param>
173    Private Shared Sub CopyStream(ByVal inStream As Stream, ByVal outStream As Stream)
174        If inStream Is Nothing Then Throw New ArgumentNullException("inStream")
175        If outStream Is Nothing Then Throw New ArgumentNullException("outStream")
176        If Not inStream.CanRead Then Throw New ArgumentException("Input stream can not read.")
177        If Not outStream.CanWrite Then Throw New ArgumentException("Output stream can not write.")
178        If inStream.CanSeek AndAlso inStream.Length = 0 Then Throw New ArgumentException("Input stream do not have data.")
179
180        Do
181            Dim buffer(1024) As Byte
182            Dim i As Integer = buffer.Length
183            i = inStream.Read(buffer, 0, i)
184            If i = 0 Then Exit Do
185            outStream.Write(buffer, 0, i)
186        Loop
187    End Sub
188
189    '''<summary>
190    '''headerInfo�̃L�[���Ŏw�肳�ꂽHTTP�w�b�_������E�i�[����redirect��������ocation�w�b�_�̓���L����    '''</summary>
191    '''<param name="webResponse">HTTP����</param>
192    '''<param name="headerInfo">[IN/OUT]�L�[�Ƀw�b�_����肵���f�[�^��R���N�V�����B�擾�����l��[�^�ɃZ�b�g���Ė߂�</param>
193    Private Shared Sub GetHeaderInfo(ByVal webResponse As HttpWebResponse, _
194                                    ByVal headerInfo As Dictionary(Of String, String))
195
196        If headerInfo Is Nothing Then Exit Sub
197
198        If headerInfo.Count > 0 Then
199            Dim keys(headerInfo.Count - 1) As String
200            headerInfo.Keys.CopyTo(keys, 0)
201            For Each key As String In keys
202                If Array.IndexOf(webResponse.Headers.AllKeys, key) > -1 Then
203                    headerInfo.Item(key) = webResponse.Headers.Item(key)
204                Else
205                    headerInfo.Item(key) = ""
206                End If
207            Next
208        End If
209
210        Dim statusCode As HttpStatusCode = webResponse.StatusCode
211        If statusCode = HttpStatusCode.MovedPermanently OrElse _
212           statusCode = HttpStatusCode.Found OrElse _
213           statusCode = HttpStatusCode.SeeOther OrElse _
214           statusCode = HttpStatusCode.TemporaryRedirect Then
215            If headerInfo.ContainsKey("Location") Then
216                headerInfo.Item("Location") = webResponse.Headers.Item("Location")
217            Else
218                headerInfo.Add("Location", webResponse.Headers.Item("Location"))
219            End If
220        End If
221    End Sub
222
223    '''<summary>
224    '''�N�G���R���N�V������=value�`���̕�����\�����Ė߂�
225    '''</summary>
226    '''<param name="param">�N�G���A�܂��̓|�X�g�f�[�^�ƂȂ�y-value�R���N�V����</param>
227    Protected Shared Function CreateQueryString(ByVal param As SortedList(Of String, String)) As String
228        If param Is Nothing OrElse param.Count = 0 Then Return String.Empty
229
230        Dim query As New StringBuilder
231        For Each key As String In param.Keys
232            query.AppendFormat("{0}={1}&", UrlEncode(key), UrlEncode(param(key)))
233        Next
234        Return query.ToString(0, query.Length - 1)
235    End Function
236
237    '''<summary>
238    '''�N�G���`���ikey1=value1&key2=value2&...�j�̕�����ey-value�R���N�V�����ɋl�ߒ���
239    '''</summary>
240    '''<param name="queryString">�N�G��������aram>
241    '''<returns>key-value�̃R���N�V����</returns>
242    Protected Shared Function ParseQueryString(ByVal queryString As String) As NameValueCollection
243        Dim query As New NameValueCollection
244        Dim parts() As String = queryString.Split("&"c)
245        For Each part As String In parts
246            Dim index As Integer = part.IndexOf("="c)
247            If index = -1 Then
248                query.Add(Uri.UnescapeDataString(part), "")
249            Else
250                query.Add(Uri.UnescapeDataString(part.Substring(0, index)), Uri.UnescapeDataString(part.Substring(index + 1)))
251            End If
252        Next
253        Return query
254    End Function
255
256    '''<summary>
257    '''2�o�C�g������������Url�G���R�[�h
258    '''</summary>
259    '''<param name="str">�G���R�[�h���镶����aram>
260    '''<returns>�G���R�[�h���ʕ�����eturns>
261    Protected Shared Function UrlEncode(ByVal stringToEncode As String) As String
262        Const UnreservedChars As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~"
263        Dim sb As New StringBuilder
264        Dim bytes As Byte() = Encoding.UTF8.GetBytes(stringToEncode)
265
266        For Each b As Byte In bytes
267            If UnreservedChars.IndexOf(Chr(b)) <> -1 Then
268                sb.Append(Chr(b))
269            Else
270                sb.AppendFormat("%{0:X2}", b)
271            End If
272        Next
273        Return sb.ToString()
274    End Function
275
276#Region "DefaultTimeout"
277    '''<summary>
278    '''�ʐM�^�C���A�E�g���ԁims�j
279    '''</summary>
280    Private Shared timeout As Integer = 20000
281
282    '''<summary>
283    '''�ʐM�^�C���A�E�g���ԁims�j�B10�`120�b�͈̔͂Ŏw���͈͊O��0�b�Ƃ���    '''</summary>
284    Protected Shared Property DefaultTimeout() As Integer
285        Get
286            Return timeout
287        End Get
288        Set(ByVal value As Integer)
289            Const TimeoutMinValue As Integer = 10000
290            Const TimeoutMaxValue As Integer = 120000
291            Const TimeoutDefaultValue As Integer = 20000
292            If value < TimeoutMinValue OrElse value > TimeoutMaxValue Then
293                ' �͈͊O�Ȃ��t�H���g�l�ݒ�                timeout = TimeoutDefaultValue
294            Else
295                timeout = value
296            End If
297        End Set
298    End Property
299#End Region
300
301    '''<summary>
302    '''�ʐM�N���X�̏������B�^�C���A�E�g�l�ƃv���L�V��肷��    '''</summary>
303    '''<remarks>
304    '''�ʐM�J�n�O�ɍŒ��x�Ăяo������
305    '''</remarks>
306    '''<param name="timeout">�^�C���A�E�g�l�i�b�j</param>
307    '''<param name="proxyType">�Ȃ��E�w��IE�f�t�H���g</param>
308    '''<param name="proxyAddress">�v���L�V�̃z�X�g��orIP�A�h���X</param>
309    '''<param name="proxyPort">�v���L�V�̃|�[�g�ԍ�</param>
310    '''<param name="proxyUser">�v���L�V�F�؂��K�v�ȏꍇ�̃��[�U���B�s�v�Ȃ�����</param>
311    '''<param name="proxyPassword">�v���L�V�F�؂��K�v�ȏꍇ�̃p�X���[�h�B�s�v�Ȃ�����</param>
312    Public Shared Sub InitializeConnection( _
313            ByVal timeout As Integer, _
314            ByVal proxyType As ProxyType, _
315            ByVal proxyAddress As String, _
316            ByVal proxyPort As Integer, _
317            ByVal proxyUser As String, _
318            ByVal proxyPassword As String)
319        isInitialize = True
320        ServicePointManager.Expect100Continue = False
321        DefaultTimeout = timeout * 1000     's -> ms
322        Select Case proxyType
323            Case proxyType.None
324                proxy = Nothing
325            Case proxyType.Specified
326                proxy = New WebProxy("http://" + proxyAddress + ":" + proxyPort.ToString)
327                If Not String.IsNullOrEmpty(proxyUser) OrElse Not String.IsNullOrEmpty(proxyPassword) Then
328                    proxy.Credentials = New NetworkCredential(proxyUser, proxyPassword)
329                End If
330            Case proxyType.IE
331                'IE�ݒ��V�X�e���ݒ��̓f�t�H���g�l�Ȃ̂ŏ������Ȃ�
332        End Select
333        proxyType = proxyType
334    End Sub
335End Class
Note: See TracBrowser for help on using the browser.