VB.NETでFTPでファイルを送信するには (ID:144860)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

FTPでFTPサーバーに画像ファイルを転送しようとしているのですが、
２回目の送信を行うとフリーズしてしまいます。
止まっている箇所はSendData()内の■■■■■■■■■■印のある行のようです。
FTPへの接続で失敗することはなく、フリーズしてしまうのは１回目はあまりなく
２回目がほとんど止まってしまいます。
このソースコードはある所のサンプルを元に少し変更を加えたものなのですが、
提供元には聞くことが出来ず、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 = "*********" 'ユーザーＩＤ
        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

←解決時は質問者本人がここをチェックしてください。

戻る