locked
WebRequestによるファイルアップロードについて RRS feed

  • 質問

  • WebRequestによるファイルアップロードについて

    お世話になります。
    ファイルアップロード機能をWebRequestで作成したいのですが
    「進捗表示とキャンセル機能」の実装がうまくいかず、困っています。
    ご存知の方がおられましたらご教示頂けないでしょうか。
    なお環境はWin7ProSP1+VS2010でSilverlightはVBで開発しています。

    【現状】
    現在、次の①~⑤のイメージでアップロード機能を実装しました。

    ①OpenFileDialogでファイル選択します

    ②プログレスバーとキャンセルボタン付きの処理中ダイアログ画面を表示します。

    ③HttpWebRequestのBeginGetRequestStreamでアップロードを開始します。
    CallBack関数は④を指定します。
    (Methodは"POST"、ContentTypeは"application/octet-stream"です。)

    ④OpenFileDialogで取得された入力ファイルストリームのデータを
    一定バイト数単位で読み込み、CallBack関数内で取得されたサーバ転送用ストリームに
    入力ファイルEOFまでループ処理で書き込みます。
    (入力→書き込みのループ処理中に
    SynchronizationContextクラスのPostメソッドを利用して
    処理中ダイアログ画面のプログレスバーを更新しています。)
    書き込み終了後、BeginGetResponseでレスポンス取得を開始します。
    CallBack関数は⑤を指定します。

    ⑤サーバからのレスポンス内容をチェックし、アップロード処理を終了し、処理中ダイアログ画面を閉じます。


    【問題】
    上記④におけるプログレスバー更新が、瞬時に終了します。
    ところが実際のアップロード処理は完了しておらず、しばらくしてから⑤のCallBack関数が実行されます。
    おそらくサーバ転送用ストリームのバッファへの書き込みが完了した時点で、
    ④のなかで書き込み完了とみなしているからだと思われます。
    そのため、③でHttpWebRequestのAllowWriteStreamBufferingプロパティにFalseをセットしたのですが
    BrowserHttpWebRequest は、バッファーなしの書き込みストリームをサポートしていません。
    という例外が発生し、この事象は改善されません。

    なんらかの方法で
    HttpWebRequestのAllowWriteStreamBufferingプロパティのFalseを有効にすることは可能でしょうか?

    あるいはHTTPプロトコルを使用したアップロードで
    進捗状況を表示し、なおかつキャンセルボタンがクリックされると
    アップロード処理をキャンセルするような方法、サンプル等があれば、
    ご教示頂けないでしょうか。

    【その他】
    説明が不十分な点もありますが、次のようなソースです。
    ①②のソース

    	Private Sub btnUpload_Click(ByVal sender As System.Object, ByVal e As System.Windows.RoutedEventArgs) Handles btnUpload.Click
    		Dim ofd As OpenFileDialog = New OpenFileDialog()
    		ofd.Multiselect = False
    		If ofd.ShowDialog() = True Then
    			'選択されたファイルのファイルサイズおよび拡張子をチェック
    			Select Case _checkUploadFile(ofd.File.Name, ofd.File.Length)
    				Case _UPLOAD_FILE_CHECK_OK
    					MessageBox.Show("ファイル名" & ofd.File.Name & "(" & ofd.File.Length & "Byte)のアップロードを開始します")
    					'プログレスバーつき処理中ダイアログ表示(プログレスバーの最大値はアップロードするファイルサイズとする)
    					ProcDlogShow(ofd.File.Length)
    					'非UIスレッドでプログレスバーを更新するためSynchronizationContextハンドルをPublic変数にセット
    					syncContext = SynchronizationContext.Current
    					'Silverlight側にはサーバからユーザーIDが転送済みであり、ユーザーIDと日時情報をもとにサーバ側でユニークになるファイル名を生成する
    					Dim serverFileName As String = _genServerFileName()
    					'以下の関数でファイルアップロードを行います
    					httpFileUpload(ofd.File.Name, ofd.File.Length, serverFileName, ofd.File.OpenRead)
    				Case _UPLOAD_FILE_SIZE_ERROR
    					MessageBox.Show("選択されたファイルのサイズがアップロード可能な最大サイズを超えています")
    					ofd.File.OpenRead.Close()
    				Case _UPLOAD_FILE_EXT_ERROR
    					MessageBox.Show("選択されたファイルの拡張子はアップロードが禁止されています")
    					ofd.File.OpenRead.Close()
    			End Select
    		End If
    
    	End Sub
    
    

    ③のソース

    		'第1引数(localFileName):OpenFileDialogで選択されたローカルファイル名称
    		'第2引数(localFileSize):OpenFileDialogで選択されたファイルサイズ
    		'第3引数(serverFileName):サーバーで保存する際のファイル名(DBサーバで管理しているユーザーIDをもとに呼び出し元で決定)
    		'第4引数(dataStream):OpenFileDialogで選択されたファイルの入力ストリーム
    		Public Sub httpFileUpload(ByVal localFileName As String, ByVal localFileSize As Long, ByVal serverFileName As String, ByVal localFileStream As Stream)
    			Try
    				enumUploadStatus = UPLOAD_STATUS.UPLOADING
    				bUploadCancelFlg = False
    				'URL生成
    				Dim req_uri As String = genBaseURL()
    				req_uri = req_uri & "File/ajaxUpload/save/" & serverFileName & "/size/" & CStr(localFileSize)
    				'リクエストの設定
    				Dim wreq As HttpWebRequest = CType(WebRequest.Create(req_uri), HttpWebRequest)
    				wreq.Method = "POST"
    				wreq.ContentType = "application/octet-stream"
    				'サーバにはファイル内容以外に「ローカル環境でのファイル名、およびそのバイト数情報4桁」を付与して転送します
    				Dim data_length As Integer = System.Text.Encoding.GetEncoding("utf-8").GetByteCount(localFileName) + localFileSize + 4
    				wreq.ContentLength = data_length
    				'CallBack関数で使用する情報をモジュール内Private変数にセット
    				_localFileName = localFileName
    				_localFileSize = localFileSize
    				_serverFileName = serverFileName
    				_localFileStream = localFileStream
    
    				'### このプロパティを設定すると例外発生
    				'wreq.AllowWriteStreamBuffering = False
    
    				'CallBack関数割り当て
    				wreq.BeginGetRequestStream(New AsyncCallback(AddressOf _writeStream), wreq)
    			Catch ex As Exception
    				'例外
    				enumUploadStatus = UPLOAD_STATUS.EXCEPTION_HEADER
    				_localFileStream.Close()
    				g_err_msg = ex.Message
    				MessageBox.Show("例外発生:" & ex.Message)
    			End Try
    		End Sub
    
    

    ④のソース

    		Private Sub _writeStream(ByVal asynchronousResult As IAsyncResult)
    			Dim buf_size As Integer
    			Dim io_buf(_CST_IO_BUF_SIZE) As Byte '_CST_IO_BUF_SIZEには1200がセットされています
    			'サーバ転送用ストリームハンドラ取得
    			Dim req As WebRequest = Nothing
    			Dim req_stream As Stream = Nothing
    			Try
    				'サーバ転送用ストリーム取得
    				req = asynchronousResult.AsyncState
    				req_stream = req.EndGetRequestStream(asynchronousResult)
    				'ストリーム先頭4バイトはローカルファイル名称レングス
    				buf_size = System.Text.Encoding.GetEncoding("utf-8").GetByteCount(_localFileName)
    				Dim s As String = Format(buf_size, "0000")
    				'io_buf = System.Text.Encoding.GetEncoding("utf-8").GetBytes(s)
    				req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes(s), 0, 4)
    				'続けてローカルファイル名称
    				req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes(_localFileName), 0, buf_size)
    				'ローカルファイル内容を一定バイト数単位で出力
    				Do
    					buf_size = _localFileStream.Read(io_buf, 0, _CST_IO_BUF_SIZE)
    					If (buf_size > 0) Then
    						req_stream.Write(io_buf, 0, buf_size)
    					End If
    					'プログレスバー更新
    					syncContext.Post(AddressOf uploadProcCheck, buf_size)
    					If bUploadCancelFlg = True Then
    						enumUploadStatus = UPLOAD_STATUS.CANCEL
    						Exit Do
    					End If
    					If (buf_size < _CST_IO_BUF_SIZE) Then Exit Do
    				Loop
    			Catch ex As Exception
    				'例外
    				enumUploadStatus = UPLOAD_STATUS.EXCEPTION_BODY
    				g_err_msg = ex.Message
    			Finally
    				If Not _localFileStream Is Nothing Then
    					_localFileStream.Close()
    				End If
    				If Not req_stream Is Nothing Then
    					req_stream.Close()
    				End If
    				If (enumUploadStatus = UPLOAD_STATUS.UPLOADING) Then
    					req.BeginGetResponse(New AsyncCallback(AddressOf _checkResponse), req)
    				End If
    			End Try
    		End Sub
    
    

    ⑤のソース

    		Private Sub _checkResponse(ByVal asynchronousResult As IAsyncResult)
    			Dim req As WebRequest
    			Dim res As WebResponse = Nothing
    			Dim resStream As Stream = Nothing
    			Dim sr As StreamReader = Nothing
    			Dim result As String = ""
    			Try
    				req = asynchronousResult.AsyncState
    				res = req.EndGetResponse(asynchronousResult)
    				resStream = res.GetResponseStream()
    				sr = New StreamReader(resStream)
    				result = sr.ReadToEnd()
    			Catch ex As Exception
    				'例外
    				enumUploadStatus = UPLOAD_STATUS.EXCEPTION_RESPONCE
    				g_err_msg = ex.Message
    			Finally
    				If Not resStream Is Nothing Then
    					resStream.Close()
    				End If
    				If Not sr Is Nothing Then
    					sr.Close()
    				End If
    				If Not res Is Nothing Then
    					res.Close()
    				End If
    				ProcDlogClose()
    			End Try
    			'受信内容チェック
    			syncContext.Post(AddressOf uploadResultCheck, result)
    		End Sub
    
    

    2011年5月11日 4:10

回答

  • いつもお世話になっています。質問者です。
    この件、とりあえず解決しましたが、新たな問題が発生しました。

    【解決方法】

    ③の関数先頭に
    httpResult = WebRequest.RegisterPrefix("http://", WebRequestCreator.ClientHttp)
    httpsResult = WebRequest.RegisterPrefix("https://", WebRequestCreator.ClientHttp)
    を追加すれば、IEでは解決しました。

    【新たな問題】
    IE以外のブラウザで、SSLプロトコルを選択したり、ダイジェスト認証を行うと、アップロードが行えません。
    これはおそらくSilverlight側の不具合と思われるので、フィードバックセンター
    https://connect.microsoft.com/VisualStudioJapan/Feedback
    にバグとして、これから報告します。

    【その他】
    質問時のソースに一部問題があったので、①~⑤のソースコードを以下のものに改めさせて頂きます。
    (以下に記載されていない箇所はコメント等を参考にしてください。)

    ①②のソース

    	Private Sub btnUpload_Click(ByVal sender As System.Object, ByVal e As System.Windows.RoutedEventArgs) Handles btnUpload.Click
    		Dim ofd As OpenFileDialog = New OpenFileDialog()
    		ofd.Multiselect = False
    		If ofd.ShowDialog() = True Then
    			'選択されたファイルのファイルサイズおよび拡張子をチェック
    			Select Case _checkUploadFile(ofd.File.Name, ofd.File.Length)
    				Case _UPLOAD_FILE_CHECK_OK
    					MessageBox.Show("ファイル名" & ofd.File.Name & "(" & ofd.File.Length & "Byte)のアップロードを開始します")
    					'プログレスバーつき処理中ダイアログ表示(プログレスバーの最大値はアップロードするファイルサイズとする)
    					__showProcDlog(ofd.File.Length)
    					'非UIスレッドでプログレスバーを更新するためSynchronizationContextハンドルをPublic変数にセット
    					__syncContext = SynchronizationContext.Current
    					'Silverlight側にはサーバからユーザーIDが転送済みであり、ユーザーIDと日時情報をもとにサーバ側でユニークになるファイル名を生成する
    					Dim serverFileName As String = _genServerFileName()
    					'以下の関数でファイルアップロードを行います
    					__httpFileUpload(ofd.File.Name, ofd.File.Length, serverFileName, ofd.File.OpenRead)
    				Case _UPLOAD_FILE_SIZE_ERROR
    					MessageBox.Show("選択されたファイルのサイズがアップロード可能な最大サイズを超えています")
    					ofd.File.OpenRead.Close()
    				Case _UPLOAD_FILE_EXT_ERROR
    					MessageBox.Show("選択されたファイルの拡張子はアップロードが禁止されています")
    					ofd.File.OpenRead.Close()
    			End Select
    		End If
    
    	End Sub
    
    

    ③のソース

    		'第1引数(localFileName):OpenFileDialogで選択されたローカルファイル名称
    		'第2引数(localFileSize):OpenFileDialogで選択されたファイルサイズ
    		'第3引数(serverFileName):サーバーで保存する際のファイル名(DBサーバで管理しているユーザーIDをもとに呼び出し元で決定)
    		'第4引数(dataStream):OpenFileDialogで選択されたファイルの入力ストリーム
    		Public Sub __httpFileUpload(ByVal localFileName As String, ByVal localFileSize As Long, ByVal serverFileName As String, ByVal localFileStream As Stream)
    			Try
    				Dim httpResult As Boolean = True
    				Dim httpsResult As Boolean = True
    				'ClientHttpを使用(__setClientHttpはアプリケーション起動時にFalseが設定されているグローバル変数)
    				If __setClientHttp = False Then
    					'RegisterPrefixは一度しか登録できない(アップロード処理終了後、WebRequestCreator.BrowserHttpにリセットできません)
    					httpResult = WebRequest.RegisterPrefix("http://", WebRequestCreator.ClientHttp)
    					httpsResult = WebRequest.RegisterPrefix("https://", WebRequestCreator.ClientHttp)
    					__setClientHttp = True
    				End If
    				If httpResult = True And httpsResult = True Then
    					'内部ステータス情報設定
    					__enumUploadStatus = UPLOAD_STATUS.UPLOADING
    					__bUploadCancelFlg = False
    					'URL生成
    					Dim req_uri As String = __genBaseURL()
    					req_uri = req_uri & "File/ajaxUpload/save/" & serverFileName & "/size/" & CStr(localFileSize)
    					'リクエストの設定
    					Dim wreq As HttpWebRequest = CType(WebRequest.Create(req_uri), HttpWebRequest)
    					wreq.Method = "POST"
    					wreq.ContentType = "application/octet-stream"
    					'サーバにはファイル内容以外に「ローカル環境でのファイル名、およびそのバイト数情報4桁、"EOS"という3バイト文字列」を付与して転送します
    					Dim data_length As Integer = System.Text.Encoding.GetEncoding("utf-8").GetByteCount(localFileName) + localFileSize + 4 + 3
    					wreq.ContentLength = data_length
    					'CallBack関数で使用する情報をモジュール内Private変数にセット
    					_localFileName = localFileName
    					_localFileSize = localFileSize
    					_serverFileName = serverFileName
    					_localFileStream = localFileStream
    					'このプロパティを有効にするためにClientHttpを使用
    					wreq.AllowWriteStreamBuffering = False
    					'CallBack関数割り当て
    					wreq.BeginGetRequestStream(New AsyncCallback(AddressOf _writeRequestBodyStream), wreq)
    				Else
    					MessageBox.Show("ClientHttpの指定に失敗しました")
    					_localFileStream.Close()
    					__closeProcDlog()
    				End If
    			Catch ex As Exception
    				'例外
    				MessageBox.Show("例外発生:" & ex.Message)
    				__enumUploadStatus = UPLOAD_STATUS.EXCEPTION_HEADER
    				_localFileStream.Close()
    				__g_err_msg = ex.Message
    				__closeProcDlog()
    			End Try
    		End Sub
    
    

    ④のソース

    		'リクエストボディ送信
    		Private Sub _writeRequestBodyStream(ByVal asynchronousResult As IAsyncResult)
    			Dim buf_size As Integer
    			Dim io_buf(_CST_IO_BUF_SIZE) As Byte '_CST_IO_BUF_SIZEには1200がセットされています
    			'サーバ転送用ストリームハンドラ取得
    			Dim req As WebRequest = Nothing
    			'Dim _req_stream As Stream = Nothing
    			Dim write_result As IAsyncResult = Nothing
    			Dim i As Integer = 0
    			Dim dummy As Object = Nothing
    			Try
    				'サーバ転送用ストリーム取得
    				req = asynchronousResult.AsyncState
    				_req_stream = req.EndGetRequestStream(asynchronousResult)
    				'ストリーム先頭4バイトはローカルファイル名称レングス
    				buf_size = System.Text.Encoding.GetEncoding("utf-8").GetByteCount(_localFileName)
    				Dim s As String = Format(buf_size, "0000")
    				_req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes(s), 0, 4)
    				'続けてローカルファイル名称
    				_req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes(_localFileName), 0, buf_size)
    				'ローカルファイル内容を一定バイト数単位で出力
    				Do
    					buf_size = _localFileStream.Read(io_buf, 0, _CST_IO_BUF_SIZE)
    					If (buf_size > 0) Then
    						_req_stream.Write(io_buf, 0, buf_size)
    						_req_stream.Flush()
    					End If
    					'プログレスバー更新
    					__syncContext.Post(AddressOf _uploadProcCheck, buf_size)
    					If __bUploadCancelFlg = True Then
    						Exit Do
    					End If
    					If (buf_size < _CST_IO_BUF_SIZE) Then Exit Do
    				Loop
    				'ローカルファイル内容出力後、キャンセルボタンがクリックされていなければEOSを出力
    				If (__enumUploadStatus = UPLOAD_STATUS.UPLOADING) Then
    					_req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes("EOS"), 0, 3)
    				End If
    			Catch ex As Exception
    				'例外
    				__enumUploadStatus = UPLOAD_STATUS.EXCEPTION_BODY
    				__g_err_msg = "_writeRequestBodyStream::" & ex.Message
    			Finally
    				If Not _localFileStream Is Nothing Then
    					_localFileStream.Close()
    				End If
    				If Not _req_stream Is Nothing Then
    					_req_stream.Close()
    				End If
    				If (__enumUploadStatus = UPLOAD_STATUS.UPLOADING) Then
    					'リクエストボディ送信正常終了時はサーバからのレスポンス受信用CallBack関数を登録
    					req.BeginGetResponse(New AsyncCallback(AddressOf _checkResponse), req)
    				Else
    					'例外発生またはキャンセルボタンクリック
    					'受信内容チェック
    					__syncContext.Post(AddressOf _uploadResultCheck, Nothing)
    					'処理中ダイアログClose
    					__syncContext.Post(AddressOf __closeProcDlog, Nothing)
    				End If
    			End Try
    		End Sub
    
    

    ⑤のソース

    		'サーバからのレスポンス受信
    		Private Sub _checkResponse(ByVal asynchronousResult As IAsyncResult)
    			Dim req As WebRequest
    			Dim res As WebResponse = Nothing
    			Dim resStream As Stream = Nothing
    			Dim sr As StreamReader = Nothing
    			Dim result As String = ""
    			Try
    				req = asynchronousResult.AsyncState
    				res = req.EndGetResponse(asynchronousResult)
    				resStream = res.GetResponseStream()
    				sr = New StreamReader(resStream)
    				result = sr.ReadToEnd()
    			Catch ex As Exception
    				'例外
    				__enumUploadStatus = UPLOAD_STATUS.EXCEPTION_RESPONCE
    				__g_err_msg = "_checkResponse::" & ex.Message
    			Finally
    				If Not resStream Is Nothing Then
    					resStream.Close()
    				End If
    				If Not sr Is Nothing Then
    					sr.Close()
    				End If
    				If Not res Is Nothing Then
    					res.Close()
    				End If
    				'受信内容チェック
    				__syncContext.Post(AddressOf _uploadResultCheck, result)
    				'処理中ダイアログClose
    				__syncContext.Post(AddressOf __closeProcDlog, Nothing)
    			End Try
    		End Sub
    
    

     

    • 回答としてマーク VB6おやじ 2011年5月28日 5:54
    2011年5月28日 5:53
  • こんにちは、VB6おやじ さん。

    MSDN フォーラムのご利用ありがとうございます。オペレーターの山本です。

    Connect へご登録いただいたとのことでしたので、このスレッドを参照されている方のためにリンクを貼らせていただきますね。

      クライアントHTTP処理のIE以外のブラウザでの動作不具合
      https://connect.microsoft.com/VisualStudioJapan/feedback/details/671264/-http-ie
                                                                                                                                   
    日本マイクロソフト株式会社 フォーラム オペレーター 山本 春海

    • 回答としてマーク 山本春海 2011年5月30日 2:12
    2011年5月30日 2:12

すべての返信

  • 送信する前からEndGetRequestStream()を呼んでいるように見えましたが。
    2011年5月11日 8:02
  • BeginWrite, EndWriteを使って自前で待つように実装できないでしょうか。他にはFlushを明示的に呼び出して、バッファにたまっている内容を書きだす方法はどうでしょうか?(Silverlightで意図したとおりに動くかは未確認)

     


    かずき Blog:http://d.hatena.ne.jp/okazuki/ VS 2010のデザイナでBlendのBehaviorをサポートするツール公開してます。 http://vsbehaviorsupport.codeplex.com/
    2011年5月11日 14:48
  • 佐祐理様

    お世話になります。コメントありがとうございます。
    結論から記すとEndGetRequestStreamの使い方に間違いはありません。

    httpリクエストを
    (A)ヘッダの送信
    (B)ボディの送信
    (C)レスポンスの受信
    に分けて考えると
    BeginGetRequestStreamで(A)を開始し、
    EndGetRequestStreamで(A)を終了して(B)用のストリームハンドルを取得する、
    という流れになります。

    EndGetRequestStreamというメソッド名は誤解を招きやすく、またボディ送信を伴わないhttpリクエストの処理パターンとも異なるのでわかりにくいですが、EndGetRequestStreamの使い方に間違いはありません。

    以上

    2011年5月12日 8:39
  • かずき_okazuki様

    お世話になります。コメントありがとうございます。
    結論から記すとダメでした。
    「Flushだけを追加したパターン」「送信をBeginWriteとEndWriteに組み替えたパターン」「送信をBeginWriteとEndWriteに組み替え、なおかつFlushを追加したパターン」の3パターンを試したのですが、全てダメでした。

    以上

    2011年5月12日 8:40
  • 勘違いしてました。おっしゃる通りです。
    2011年5月12日 13:52
  • いつもお世話になっています。質問者です。
    この件、とりあえず解決しましたが、新たな問題が発生しました。

    【解決方法】

    ③の関数先頭に
    httpResult = WebRequest.RegisterPrefix("http://", WebRequestCreator.ClientHttp)
    httpsResult = WebRequest.RegisterPrefix("https://", WebRequestCreator.ClientHttp)
    を追加すれば、IEでは解決しました。

    【新たな問題】
    IE以外のブラウザで、SSLプロトコルを選択したり、ダイジェスト認証を行うと、アップロードが行えません。
    これはおそらくSilverlight側の不具合と思われるので、フィードバックセンター
    https://connect.microsoft.com/VisualStudioJapan/Feedback
    にバグとして、これから報告します。

    【その他】
    質問時のソースに一部問題があったので、①~⑤のソースコードを以下のものに改めさせて頂きます。
    (以下に記載されていない箇所はコメント等を参考にしてください。)

    ①②のソース

    	Private Sub btnUpload_Click(ByVal sender As System.Object, ByVal e As System.Windows.RoutedEventArgs) Handles btnUpload.Click
    		Dim ofd As OpenFileDialog = New OpenFileDialog()
    		ofd.Multiselect = False
    		If ofd.ShowDialog() = True Then
    			'選択されたファイルのファイルサイズおよび拡張子をチェック
    			Select Case _checkUploadFile(ofd.File.Name, ofd.File.Length)
    				Case _UPLOAD_FILE_CHECK_OK
    					MessageBox.Show("ファイル名" & ofd.File.Name & "(" & ofd.File.Length & "Byte)のアップロードを開始します")
    					'プログレスバーつき処理中ダイアログ表示(プログレスバーの最大値はアップロードするファイルサイズとする)
    					__showProcDlog(ofd.File.Length)
    					'非UIスレッドでプログレスバーを更新するためSynchronizationContextハンドルをPublic変数にセット
    					__syncContext = SynchronizationContext.Current
    					'Silverlight側にはサーバからユーザーIDが転送済みであり、ユーザーIDと日時情報をもとにサーバ側でユニークになるファイル名を生成する
    					Dim serverFileName As String = _genServerFileName()
    					'以下の関数でファイルアップロードを行います
    					__httpFileUpload(ofd.File.Name, ofd.File.Length, serverFileName, ofd.File.OpenRead)
    				Case _UPLOAD_FILE_SIZE_ERROR
    					MessageBox.Show("選択されたファイルのサイズがアップロード可能な最大サイズを超えています")
    					ofd.File.OpenRead.Close()
    				Case _UPLOAD_FILE_EXT_ERROR
    					MessageBox.Show("選択されたファイルの拡張子はアップロードが禁止されています")
    					ofd.File.OpenRead.Close()
    			End Select
    		End If
    
    	End Sub
    
    

    ③のソース

    		'第1引数(localFileName):OpenFileDialogで選択されたローカルファイル名称
    		'第2引数(localFileSize):OpenFileDialogで選択されたファイルサイズ
    		'第3引数(serverFileName):サーバーで保存する際のファイル名(DBサーバで管理しているユーザーIDをもとに呼び出し元で決定)
    		'第4引数(dataStream):OpenFileDialogで選択されたファイルの入力ストリーム
    		Public Sub __httpFileUpload(ByVal localFileName As String, ByVal localFileSize As Long, ByVal serverFileName As String, ByVal localFileStream As Stream)
    			Try
    				Dim httpResult As Boolean = True
    				Dim httpsResult As Boolean = True
    				'ClientHttpを使用(__setClientHttpはアプリケーション起動時にFalseが設定されているグローバル変数)
    				If __setClientHttp = False Then
    					'RegisterPrefixは一度しか登録できない(アップロード処理終了後、WebRequestCreator.BrowserHttpにリセットできません)
    					httpResult = WebRequest.RegisterPrefix("http://", WebRequestCreator.ClientHttp)
    					httpsResult = WebRequest.RegisterPrefix("https://", WebRequestCreator.ClientHttp)
    					__setClientHttp = True
    				End If
    				If httpResult = True And httpsResult = True Then
    					'内部ステータス情報設定
    					__enumUploadStatus = UPLOAD_STATUS.UPLOADING
    					__bUploadCancelFlg = False
    					'URL生成
    					Dim req_uri As String = __genBaseURL()
    					req_uri = req_uri & "File/ajaxUpload/save/" & serverFileName & "/size/" & CStr(localFileSize)
    					'リクエストの設定
    					Dim wreq As HttpWebRequest = CType(WebRequest.Create(req_uri), HttpWebRequest)
    					wreq.Method = "POST"
    					wreq.ContentType = "application/octet-stream"
    					'サーバにはファイル内容以外に「ローカル環境でのファイル名、およびそのバイト数情報4桁、"EOS"という3バイト文字列」を付与して転送します
    					Dim data_length As Integer = System.Text.Encoding.GetEncoding("utf-8").GetByteCount(localFileName) + localFileSize + 4 + 3
    					wreq.ContentLength = data_length
    					'CallBack関数で使用する情報をモジュール内Private変数にセット
    					_localFileName = localFileName
    					_localFileSize = localFileSize
    					_serverFileName = serverFileName
    					_localFileStream = localFileStream
    					'このプロパティを有効にするためにClientHttpを使用
    					wreq.AllowWriteStreamBuffering = False
    					'CallBack関数割り当て
    					wreq.BeginGetRequestStream(New AsyncCallback(AddressOf _writeRequestBodyStream), wreq)
    				Else
    					MessageBox.Show("ClientHttpの指定に失敗しました")
    					_localFileStream.Close()
    					__closeProcDlog()
    				End If
    			Catch ex As Exception
    				'例外
    				MessageBox.Show("例外発生:" & ex.Message)
    				__enumUploadStatus = UPLOAD_STATUS.EXCEPTION_HEADER
    				_localFileStream.Close()
    				__g_err_msg = ex.Message
    				__closeProcDlog()
    			End Try
    		End Sub
    
    

    ④のソース

    		'リクエストボディ送信
    		Private Sub _writeRequestBodyStream(ByVal asynchronousResult As IAsyncResult)
    			Dim buf_size As Integer
    			Dim io_buf(_CST_IO_BUF_SIZE) As Byte '_CST_IO_BUF_SIZEには1200がセットされています
    			'サーバ転送用ストリームハンドラ取得
    			Dim req As WebRequest = Nothing
    			'Dim _req_stream As Stream = Nothing
    			Dim write_result As IAsyncResult = Nothing
    			Dim i As Integer = 0
    			Dim dummy As Object = Nothing
    			Try
    				'サーバ転送用ストリーム取得
    				req = asynchronousResult.AsyncState
    				_req_stream = req.EndGetRequestStream(asynchronousResult)
    				'ストリーム先頭4バイトはローカルファイル名称レングス
    				buf_size = System.Text.Encoding.GetEncoding("utf-8").GetByteCount(_localFileName)
    				Dim s As String = Format(buf_size, "0000")
    				_req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes(s), 0, 4)
    				'続けてローカルファイル名称
    				_req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes(_localFileName), 0, buf_size)
    				'ローカルファイル内容を一定バイト数単位で出力
    				Do
    					buf_size = _localFileStream.Read(io_buf, 0, _CST_IO_BUF_SIZE)
    					If (buf_size > 0) Then
    						_req_stream.Write(io_buf, 0, buf_size)
    						_req_stream.Flush()
    					End If
    					'プログレスバー更新
    					__syncContext.Post(AddressOf _uploadProcCheck, buf_size)
    					If __bUploadCancelFlg = True Then
    						Exit Do
    					End If
    					If (buf_size < _CST_IO_BUF_SIZE) Then Exit Do
    				Loop
    				'ローカルファイル内容出力後、キャンセルボタンがクリックされていなければEOSを出力
    				If (__enumUploadStatus = UPLOAD_STATUS.UPLOADING) Then
    					_req_stream.Write(System.Text.Encoding.GetEncoding("utf-8").GetBytes("EOS"), 0, 3)
    				End If
    			Catch ex As Exception
    				'例外
    				__enumUploadStatus = UPLOAD_STATUS.EXCEPTION_BODY
    				__g_err_msg = "_writeRequestBodyStream::" & ex.Message
    			Finally
    				If Not _localFileStream Is Nothing Then
    					_localFileStream.Close()
    				End If
    				If Not _req_stream Is Nothing Then
    					_req_stream.Close()
    				End If
    				If (__enumUploadStatus = UPLOAD_STATUS.UPLOADING) Then
    					'リクエストボディ送信正常終了時はサーバからのレスポンス受信用CallBack関数を登録
    					req.BeginGetResponse(New AsyncCallback(AddressOf _checkResponse), req)
    				Else
    					'例外発生またはキャンセルボタンクリック
    					'受信内容チェック
    					__syncContext.Post(AddressOf _uploadResultCheck, Nothing)
    					'処理中ダイアログClose
    					__syncContext.Post(AddressOf __closeProcDlog, Nothing)
    				End If
    			End Try
    		End Sub
    
    

    ⑤のソース

    		'サーバからのレスポンス受信
    		Private Sub _checkResponse(ByVal asynchronousResult As IAsyncResult)
    			Dim req As WebRequest
    			Dim res As WebResponse = Nothing
    			Dim resStream As Stream = Nothing
    			Dim sr As StreamReader = Nothing
    			Dim result As String = ""
    			Try
    				req = asynchronousResult.AsyncState
    				res = req.EndGetResponse(asynchronousResult)
    				resStream = res.GetResponseStream()
    				sr = New StreamReader(resStream)
    				result = sr.ReadToEnd()
    			Catch ex As Exception
    				'例外
    				__enumUploadStatus = UPLOAD_STATUS.EXCEPTION_RESPONCE
    				__g_err_msg = "_checkResponse::" & ex.Message
    			Finally
    				If Not resStream Is Nothing Then
    					resStream.Close()
    				End If
    				If Not sr Is Nothing Then
    					sr.Close()
    				End If
    				If Not res Is Nothing Then
    					res.Close()
    				End If
    				'受信内容チェック
    				__syncContext.Post(AddressOf _uploadResultCheck, result)
    				'処理中ダイアログClose
    				__syncContext.Post(AddressOf __closeProcDlog, Nothing)
    			End Try
    		End Sub
    
    

     

    • 回答としてマーク VB6おやじ 2011年5月28日 5:54
    2011年5月28日 5:53
  • こんにちは、VB6おやじ さん。

    MSDN フォーラムのご利用ありがとうございます。オペレーターの山本です。

    Connect へご登録いただいたとのことでしたので、このスレッドを参照されている方のためにリンクを貼らせていただきますね。

      クライアントHTTP処理のIE以外のブラウザでの動作不具合
      https://connect.microsoft.com/VisualStudioJapan/feedback/details/671264/-http-ie
                                                                                                                                   
    日本マイクロソフト株式会社 フォーラム オペレーター 山本 春海

    • 回答としてマーク 山本春海 2011年5月30日 2:12
    2011年5月30日 2:12