同時接続及び非同期通信処理 vb.net
同時接続及び非同期通信処理 vb.net特徴・非同期通信・同時接続・クッキーに対応している・取得したデータはテキストベース(ファイルのDLについては若干修正必要)下記のコードがNetHttpModule モジュール'========================================Imports System.NetModule NetHttpModule 'Cookieを保存しておくCookieContainer Private cContainer As New System.Net.CookieContainer '受信した全データを入れておくMemoryStream Private RequestData As System.IO.MemoryStream Public Class NetHashtab Public NetText As String = "" Public Cookey_res As Boolean = False Public Text_res As Boolean = False Public IAsyncRes As Boolean = True End Class '受信したデータが一時的に入るバイト型配列 Public NetHttpData As Hashtable = New Hashtable Private Class AsyncStateObject Public Socket As String Public enc As String Public ReceiveBuffer() As Byte Public ReceivedData As System.IO.MemoryStream Public st As IO.Stream Public Sub New(ByVal soc As String, ByVal enc As String) Me.Socket = soc Me.enc = enc Me.ReceiveBuffer = New Byte(1023) {} Me.ReceivedData = New System.IO.MemoryStream Me.st = IO.Stream.Null End Sub End Class 'WebHttpRequest 要求開始 Public Sub GetHtml(ByVal url As String, ByVal Socket As String, ByVal enc As String) 'socket名義のハッシュタグリスト作成 Dim NetHttpData_Key_entry As Boolean = False For Each NetHttpData_Key As String In NetHttpData.Keys If NetHttpData_Key = Socket Then NetHttpData_Key_entry = True End If Next If NetHttpData_Key_entry = True Then NetHttpData(Socket).NetText = "" NetHttpData(Socket).Text_res = False NetHttpData(Socket).Cookey_res = False NetHttpData(Socket).IAsyncRes = True Else NetHttpData.Add(Socket, New NetHashtab) End If 'UrlにFun ResponseCallbackまで受け渡すValurを追記 If url.IndexOf("?") <> -1 Then url = url & "&Net_Socket=" & Socket & "&Net_enc=" & enc Else url = url & "?Net_Socket=" & Socket & "&Net_enc=" & enc End If 'WebRequestの作成 Dim webreq As System.Net.HttpWebRequest = CType(System.Net.WebRequest.Create(url), System.Net.HttpWebRequest) 'IEのプロキシ設定を登録 webreq.Proxy = System.Net.WebRequest.GetSystemWebProxy 'CookieContainerプロパティを設定する webreq.CookieContainer = New System.Net.CookieContainer '要求元のURIに関連したCookieを追加し、要求に使用する webreq.CookieContainer.Add(cContainer.GetCookies(webreq.RequestUri)) 'ヘッダの設定 webreq.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" webreq.Headers.Add(HttpRequestHeader.AcceptEncoding, "gzip, deflate") webreq.Headers.Add("Accept-Language", " ja,en-US;q=0.7,en;q=0.3") webreq.ContentType = "application/x-www-form-urlencoded" webreq.UserAgent = "Mozilla/5.0 (Windows NT 6.1; W…) Gecko/20100101 Firefox/60.0" Dim r As IAsyncResult = DirectCast(webreq.BeginGetResponse(New AsyncCallback(AddressOf ResponseCallback), webreq), IAsyncResult) If r.CompletedSynchronously = True Then System.Console.WriteLine(r.AsyncState, NetHttpData) End If 'System.Threading.Thread.Sleep(500) 'Application.DoEvents() Application.DoEvents() End Sub '非同期要求が終了した時に呼び出されるコールバックメソッド Private Sub ResponseCallback(ar As IAsyncResult) '状態オブジェクトとして渡されたHttpWebRequestを取得 Dim webreq As System.Net.HttpWebRequest = DirectCast(ar.AsyncState, System.Net.HttpWebRequest) 'Net_SoketとNet_encのValurを取り出す。 Dim execute_set() As String = webreq.RequestUri.ToString.Split("&") Dim enc_set() As String = {} For Each txexe As String In execute_set If txexe.IndexOf("Net_Socket") <> -1 Then execute_set = txexe.Split("=") If txexe.IndexOf("Net_enc") <> -1 Then enc_set = txexe.Split("=") Next 'Net_SocketからAsyncStateObjectオブジェクトを作成する。 Dim so As AsyncStateObject = New AsyncStateObject(execute_set(1), enc_set(1)) Dim webres As System.Net.HttpWebResponse '非同期要求を終了:HTTPエラーコード429(Too Many Requestsエラー)時は再読み込みのためIAsyncRes = Falseとする Try webres = DirectCast(webreq.EndGetResponse(ar), System.Net.HttpWebResponse) Catch ex As Exception NetHttpData(so.Socket).IAsyncRes = False Exit Sub End Try 'Cookieを取得しておく Dim cookies As System.Net.CookieCollection cookies = webreq.CookieContainer.GetCookies(webreq.RequestUri) '取得したCookieを保存しておく cContainer.Add(cookies) 'データを読み込むためのストリームを取得 so.st = webres.GetResponseStream() 'クッキー受け取り完了 NetHttpData(so.Socket).Cookey_res = True 'データを読み込むための準備をする RequestData = New System.IO.MemoryStream() so.ReceiveBuffer = New Byte(1023) {} '非同期でデータの読み込みを開始 '状態オブジェクトとしてStreamを渡す so.st.BeginRead(so.ReceiveBuffer, 0, so.ReceiveBuffer.Length, New AsyncCallback(AddressOf ReadCallback), so) End Sub '非同期読み込み完了時に呼び出されるコールバックメソッド Private Sub ReadCallback(ar As IAsyncResult) '状態オブジェクトとして渡されたStreamを取得 Dim so As AsyncStateObject = CType(ar.AsyncState, AsyncStateObject) 'データを読み込む Dim readSize As Integer = so.st.EndRead(ar) 'データが読み込めたか調べる If readSize > 0 Then 'データが読み込めた時 '読み込んだデータをMemoryStreamに保存する so.ReceivedData.Write(so.ReceiveBuffer, 0, readSize) '再び非同期でデータを読み込む so.st.BeginRead(so.ReceiveBuffer, 0, so.ReceiveBuffer.Length, New AsyncCallback(AddressOf ReadCallback), so) Else '受信Byteデータの取り出し Dim sourceData As Byte() = so.ReceivedData.ToArray() '受信Byteデーターをエンコード Dim sourceHtml As String = System.Text.Encoding.GetEncoding(so.enc).GetString(sourceData) NetHttpData(so.Socket).NetText = sourceHtml '閉じる so.st.Close() RequestData.Close() 'テキストデータ受け取り完了 NetHttpData(so.Socket).Text_res = True End If End SubEnd Module'========================================利用方法モジュールを追加作成して上記のコードを全部入れ替え(貼り付け)フォームを作成して下記のコードを全部入れ替え(貼り付け)プログラムを開始すると左上にボタンが作成されます。ボタンを押すと郵便番号(4個)のデータを取得します。※ どうしても一気にリクエストをサーバーに出すため次のようなエラーを吐く事がある HTTPエラーコード429(Too Many Requestsエラー) これが出た場合はリクエストをサーバーに再度送る。戻り値のJsonデータはテキストボックスに貼り付けて4個全て取得したら完了してボタンが押せなくなる。説明郵便番号のAPIを利用https://apis.postcode-jp.com/api/v3/postcodes?postcode=イコールの次に郵便番号を設定してサーバーに送ると情報がJsonデータで取得できる。実行前実行結果'========================================Public Class Form1 Private Button1 As Button Private TextBox1 As TextBox Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.Size = New Size(1200, 600) 'Buttonクラスのインスタンスを作成する Me.Button1 = New Button() 'Buttonコントロールのプロパティを設定する Me.Button1.Name = "Button1" Me.Button1.Text = "押してね" 'サイズと位置を設定する Me.Button1.Location = New Point(10, 10) Me.Button1.Size = New System.Drawing.Size(80, 20) 'Clickイベントハンドラを追加する AddHandler Me.Button1.Click, AddressOf Button1_Click 'フォームに追加する Me.Controls.Add(Me.Button1) End Sub Public TextBox As Hashtable = New Hashtable Public Location_count As Integer = 0 Sub TextBox1_Add(Name As String) Me.TextBox.Add(Name, New TextBox()) Me.TextBox(Name).Name = "TextBox1" Me.TextBox(Name).Text = "" Me.TextBox(Name).Location = New Point(10 + (Location_count * 290), 40) Me.TextBox(Name).Size = New System.Drawing.Size(280, 500) Me.TextBox(Name).Multiline = True Me.Controls.Add(Me.TextBox(Name)) Location_count = Location_count + 1 End Sub Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Dim Url As String = "https://apis.postcode-jp.com/api/v3/postcodes?postcode=" Dim Post() As String = {"8620941", "8600043", "8600001", "8600807"} For Each PostNo As String In Post TextBox1_Add(PostNo) Dim Url_set As String = Url & PostNo Call GetHtml(Url_set, PostNo, "UTF-8") Next Dim count_Post_res As Integer = 0 Do For Each PostNo As String In Post 'リクエスト結果が完了している場合テキストボックスに記載 If NetHttpData(PostNo).Text_res = True Then Me.TextBox(PostNo).Text = NetHttpData(PostNo).NetText NetHttpData(PostNo).Text_res = False count_Post_res = count_Post_res + 1 Application.DoEvents() End If 'サーバーがリクエストに要求しない場合は再度リクエストする。 If NetHttpData(PostNo).IAsyncRes = False Then NetHttpData(PostNo).IAsyncRes = True Dim Url_set As String = Url & PostNo Call GetHtml(Url_set, PostNo, "UTF-8") End If Next 'Postデータ今回は4個が完了したら抜ける Loop Until count_Post_res = Post.Count Button1.Enabled = False End SubEnd Class'========================================