FTPでFTPサーバーに画像ファイルを転送しようとしているのですが、
2回目の送信を行うとフリーズしてしまいます。
止まっている箇所はSendData()内の■■■■■■■■■■印のある行のようです。
FTPへの接続で失敗することはなく、フリーズしてしまうのは1回目はあまりなく
2回目がほとんど止まってしまいます。
このソースコードはある所のサンプルを元に少し変更を加えたものなのですが、
提供元には聞くことが出来ず、WEBサイトで他のFTP関連の記事を探してみたのですが、
解決策や代用になるサンプルを探し出すことができませんでした。
原因などが分かりましたらお助け頂けると幸いです。
一応下記に全部のソースコードを添付させて頂きました。
環境はVB.NET2003、Framework1.1です。
Private sc As New Sockets.Socket( _
Net.Sockets.AddressFamily.InterNetwork, _
Net.Sockets.SocketType.Stream, _
Net.Sockets.ProtocolType.Tcp)
Private Sub Form1_Load1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TextBox1.Text = "*****.****.**" 'サーバー名
TextBox2.Text = "21" 'ポート番号
TextBox3.Text = "*********" 'ユーザーID
TextBox4.Text = "******" 'パスワード
TextBox5.Text = "" '初期フォルダ
TextBox6.Text = "" 'ログ
TextBox7.Text = "c:\1.jpg" 'アップロードファイル
Button1.Text = "接続"
Button2.Text = "アップロード"
TextBox6.Multiline = True
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Button1.Text = "接続" Then
sc = New Sockets.Socket( _
Net.Sockets.AddressFamily.InterNetwork, _
Net.Sockets.SocketType.Stream, _
Net.Sockets.ProtocolType.Tcp)
FtpConnect()
Button1.Text = "閉じる"
Else
FtpClose()
Button1.Text = "接続"
End If
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim filename As String = TextBox7.Text
If Button1.Text = "接続" Then Exit Sub
Try
SendData("TYPE I")
Dim filelen As Long
Dim fi As New System.IO.FileInfo(filename)
filelen = fi.Length
FileUpload("STOR " & filename, filelen)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
End Try
End Sub
Private Sub FtpConnect()
Dim ipa As IPAddress
Dim ipep As IPEndPoint
Dim res As String
Try
ipa = Dns.Resolve(TextBox1.Text).AddressList(0)
ipep = New IPEndPoint(ipa, TextBox2.Text)
sc.Connect(ipep)
SendData("")
SendData("USER " & TextBox3.Text)
SendData("PASS " & TextBox4.Text)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
End Try
End Sub
Private Sub FtpClose()
SendData("QUIT")
sc.Shutdown(Net.Sockets.SocketShutdown.Both)
sc.Close()
End Sub
Function SendData(ByVal data As String) As Integer
Dim stat As String
Dim mstat() As String
Dim rb As Integer
Dim rbuff(256) As Byte
If data <> "" Then
Dim wbuff As Byte()
wbuff = Encoding.ASCII.GetBytes(data & vbCrLf)
sc.Send(wbuff)
If data.StartsWith("PASS") Then
data = "PASS ********"
End If
TextBox6.AppendText(data & vbCrLf)
End If
Do
Do
rbuff.Initialize()
rb = sc.Receive(rbuff) ■■■■■■■■■■
stat &= Encoding.ASCII.GetString(rbuff, 0, rb)
Loop Until sc.Available = 0
mstat = Split(stat, vbCrLf)
Loop While mstat(UBound(mstat) - 1).Substring(3, 1) <> " "c
TextBox6.AppendText(stat)
End Function
Private Sub FileUpload(ByVal data As String, ByVal FileLen As Long)
Dim ipa As IPAddress
Dim lsc As Sockets.Socket
ipa = Dns.Resolve(Dns.GetHostName()).AddressList(0)
Dim ipep As New IPEndPoint(ipa, 11000)
Dim tl As New Sockets.TcpListener(ipep)
Dim param As String
Dim cmd As String = data.Split(" "c)(0)
Dim fn As String = data.Split(" "c)(1)
Dim br As New IO.BinaryReader( _
New IO.FileStream( _
fn, _
IO.FileMode.Open, _
IO.FileAccess.Read))
Try
tl.Start()
param = ipa.ToString().Replace(".", ",") & ","
param &= CStr(ipep.Port \ 256) & ","
param &= CStr(ipep.Port Mod 256)
SendData("PORT " & param)
SendData(cmd & " " & IO.Path.GetFileName(fn))
lsc = tl.AcceptSocket
Do While br.PeekChar >= 0
Dim rb As Integer
Dim buff(FileLen) As Byte
buff = br.ReadBytes(buff.Length)
lsc.Send(buff)
Loop
br.Close()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
Finally
tl.Stop()
lsc.Shutdown(Sockets.SocketShutdown.Both)
lsc.Close()
SendData("")
End Try
End Sub
>2回目がほとんど止まってしまいます。
2回目の手順ってどっちを指してます?
①Button1_Click→Button2_Click→Button1_Click→Button2_Click
②Button1_Click→Button1_Click→Button2_Click
訂正
①Button1_Click(接)→Button2_Click→Button1_Click(閉)→
Button1_Click(接)→Button2_Click→Button1_Click(閉)
②Button1_Click(接)→Button2_Click→Button2_Click→Button1_Click(閉)
説明不足申し訳ございません。
2回目というのはアップロードのボタン(Button2)の動作のことです。
Button1の接続、切断は何回やっても止まってしまうことはないようです。
何か分かりましたらよろしくお願いいたします。
原因の調査の1つとしてご参考になれば幸いです。
http://msdn.microsoft.com/ja-jp/library/8s4y8aff(VS.80).aspx
>読み取ることができるデータが存在しない場合、Socket.ReceiveTimeout を使用してタイムアウト値が設定されていなければ、Receive メソッドは読み取ることができるデータが出現するまでブロックします。
読み取れるデータが存在しなくてブロックし続けている可能性は無いでしょうか?
すみません、追記です。
> Do
> rbuff.Initialize()
> rb = sc.Receive(rbuff) ■■■■■■■■■■
> stat &= Encoding.ASCII.GetString(rbuff, 0, rb)
> Loop Until sc.Available = 0
のUntil sc.Available = 0をDoのほうに持っていくだけで、良いかも・・・
>止まっている箇所
SendDataって何箇所かで使われているわけだし
トレースして、どのタイミングで落ちてるかまで
情報が無いと答えられない。
rbuff(256)なので256以上を送ってるとか
やじゅさま、ラスカル17さま、レスをありがとうございます。
Do Loopの式の位置を前判定に変えてみたのですが、
Index was outside the bounds of the arrayという
メッセージが出て正しく動作しませんでした。
一時停止をしてみるとDo Loopで繰り返しているのではなくて
> rb = sc.Receive(rbuff)
ここの部分で結果が帰ってこなくて止まってしまっている感じです。
やじゅさまのどのタイミングかというのは
Button2のファイル送信ボタンを押して、FileUploadを実行して
その中のTryの中にある
>SendData(cmd & " " & IO.Path.GetFileName(fn))
の時のSendData内の■■■■■■■■■■印のところで止まってしまいます。
成功した時と同じファイルなので、配列のサイズは大丈夫なように
思いますが大きくして試してみても止まってしまいました。
何かお分かりのことがありましたら、ご教授頂けると助かります。
SendDataは他でも使われていて正常に動作するよう
ですから、
cmdの値と IO.Path.GetFileName(fn)が何か提示して
ください、そこを疑ってください。
やじゅさま、またすみません。
cmd は STOR で
IO.Path.GetFileName(fn)は1.jpg
が入っています。
送られる文字列としては"STOR 1.jpg"が送られています。
ログ表示の TextBox6.Text に
STOR 1.jpg
と出た状態で止まってしまいます。
何か解決策ありますでしょうか
たびたびすみません。
今テストしていたのですが、
接続→送信 は正常で
接続→送信→送信 で停止してしまうのですが、
接続→切断→接続→送信 でも必ず止まってしまうことが分かりました。
接続→切断→接続→切断→接続→切断→接続→切断→接続
は、何回やっても止まってしまうことはありませんでした。
何かわかりましたらアドバイス頂けると幸いです。
>接続→切断→接続→送信 でも必ず止まってしまうことが分かりました。
と書いたのですが、
接続→切断→接続→送信 でも送信できることもありました。
コマンドプロンプトのFTPで手動で送信する時には
止まってしまうことはないので、サイト側の不都合とは思えないのですが、
解決策がありましたらお助けいただきたいです。
良くわかりませんが、
Loop While mstat(UBound(mstat) - 1).Substring(3, 1) <> " "c
これは何なんですかね。
sc.Send(wbuff)で投げられたコマンドに対して、返事が
sc.Available = 0
で終わったわけですから、外のループで再びはじき返されたら、何のコマンドに対する
返事を待つことになるのでしょうか。
我龍院さま、レスをありがとうございます。
Do Loopの抜け出しのために
If sc.Available <> 0 や sc.Available = 0 Then Exit Do
をあちこちに挟んでみたのですが、どうも
rb = sc.Receive(rbuff)
の行で止められているらしく、Do Loopの式の判定のところまでは
来ないようです。
一回目で止まってしまうこともあったり、2回目も成功することがあったりと
決まった動作をしてくれないので、悩ましいところです。
変数の宣言の範囲を変えたりと色々試行錯誤しているのですが、
今のところ原因は不明です。
また何かわかりましたら、レス頂ければ幸いです。
今色々試していたのですが、
>Private Sub FileUpload(ByVal data As String, ByVal FileLen As Long)
内の
>Dim ipep As New IPEndPoint(ipa, 11000)
の11000というポート番号が関係しているようです。
これはサンプルのコードで11000となっていたのですが、
どんなルールで11000を使っているのかよく分からないのですが、
これを近い時間に2度同じものを使うと不都合があるようです。
グローバル変数に
Dim P As Integer を宣言して
ipep = New IPEndPoint(ipa, 11000 + P)
P += 1
とすると、何十回とファイルを連続して送信することができました。
一度終了して再度試す場合、時間が近いとP=0スタートでは1回目から
フリーズしてしまいました。
直前にP = 50まで試した場合は次の送信では
50ではダメで51からならまた何度でも送信できました。
最初に使う21というポート番号とだいぶ離れた数字なので、
違う種類のものなのかなーと思うのですが、少し調べてみたいと思います。
このポート番号を事前に調べる方法がありましたら、教えて頂けると助かります。
サーバーにコマンドを投げて、応答が有るから下の一番中のループはぬけるけど
Do
rbuff.Initialize()
rb = sc.Receive(rbuff) ■■■■■■■■■■
stat &= Encoding.ASCII.GetString(rbuff, 0, rb)
Loop Until sc.Available = 0
外のループは
Loop While mstat(UBound(mstat) - 1).Substring(3, 1) <> " "c
が成立してDoに戻ったとき、rb = sc.Receive(rbuff)に何も来ないから
ここで待っているのでは?
我龍院さまレスありがとうございます。
DoLoopの部分の動作について確認したのですが、
改善することはできませんでした。
とりあえず今回はFTPの機能は諦めて次へ進もうと思います。
解決したらまたご報告させて頂きます。
お騒がせして申し訳ありませんでした。