VB　Winsock　ファイル転送実験

2008年02月10日 23時28分57秒 | VB Winsock

VB　Winsockでのファイル転送実験をやってみた。

以下の機能とした。

Winsockプロトコルは、TCP
データ転送はバイナリー
ファイルの指定位置を送信する。
一回の送信バイトを指定
受け取り側は、受信ごとにファイルに書きこむ

たぶんの実験結果
　　送信側
　　　　大量データを送る時、計算用の変数型はDoubleにしないと計算が合わなくなる。
　　　　繰り返しデータを送る時、SendCompleteのイベントで繰り返す。
　　受信側
　　　　必ずしも送信プログラムの分割サイズで受信はしない。
受信の都度ファイルに書き込む用にする。
今後
　　FTPのプロトコルに準じた実装を試してみたい。
　　VB2005での実験（VB2005はよく分からないな～）

参考ページ
こんな所を参考にさせていただきました。
http://www.hi-net.zaq.ne.jp/mulberry/triangle/samplevb6.htm
http://www005.upp.so-net.ne.jp/h-masuda/vb6/vb6net/index.html
http://www.picfun.com/lanframe.html

-------------------------------------------
＜FTP 送信＞

Option Explicit

Dim svLocalPort As Long
Dim svLocalAddress As String
Dim clRemotePort As Long
Dim clRemoteAddress As String

Dim hFile As Integer
Dim b_Data() As Byte
Dim T_Byte As Double
Dim cnt As Integer

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
    'Me.Text1.Text = Dir1.Path
End Sub

Private Sub Drive1_Change()
    On Error GoTo err_end
    Dir1.Path = Drive1.Drive
    'Me.Text1.Text = Drive1.Drive
    Exit Sub
err_end:
    MsgBox "選択エラー"
End Sub

Private Sub File1_Click()
    Me.Text1.Text = File1.FileName
End Sub

Private Sub Form_Load()
'
    svLocalPort = 20
    clRemotePort = 0
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Winsock1.Close
End Sub

Private Sub Command1_Click()

    If Me.Text1.Text = "" Then
        MsgBox "ファイル名を指定してください。"
        Exit Sub
    End If

'Listen
    svLocalPort = Text3.Text
    With Winsock1
        'ソケットをTCPに設定
        .Protocol = sckTCPProtocol
       
        'ローカルポートの設定
        .LocalPort = svLocalPort
        
        'リモートポートの設定
        '通常リモートポートは　0　に設定する、
        'クライアントからの接続要求時に決定される
        '使用するリモートポートはクライアント側から通知される
        .RemotePort = clRemotePort
        
        'リッスンする
        .Listen
    
    End With
    
    With Winsock1
        '接続データ表示
        Msg_Wite "LocalIP    =" + CStr(.LocalIP)
        Msg_Wite "Local Port =" + CStr(.LocalPort)
        Msg_Wite "RemoteIP   =" + CStr(.RemoteHostIP)
        Msg_Wite "Remote Port=" + CStr(.RemotePort)
        Msg_Wite "リッスン"
        
    End With

    T_Byte = 0
    cnt = 0
End Sub

Private Sub Command2_Click()
'サーバーのポートをクローズする　（通信の挙動を確認する為のルーチン）
'連続作動させる通常時はこのルーチンは必要ない、プログラムの終了時にクローズさせれば良い

    Winsock1.Close
    Msg_Wite "Close"

End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
'イベント***クライアントからの接続要求により実行される

    ' 接続を閉じてから新しい接続を受け付けます．
    Winsock1.Close
    
    ' requestID パラメーター付きの要求を受け付けます．
    Winsock1.Accept requestID
    Msg_Wite "接続要求が来ました"
    
    hFile = FreeFile
    Open File1.Path & "" & Me.Text1.Text For Binary As hFile
    '対象ファイルのバイト数を得る。
    Dim DataLen As Double
    DataLen = LOF(hFile)
    '既存データの最後にポインターを移動。
    Seek #hFile, DataLen + 1

    With Winsock1
        '接続データ表示
        Msg_Wite "LocalIP    =" + CStr(.LocalIP)
        Msg_Wite "Local Port =" + CStr(.LocalPort)
        Msg_Wite "RemoteIP   =" + CStr(.RemoteHostIP)
        Msg_Wite "Remote Port=" + CStr(.RemotePort)
        
    End With
    
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'イベント***クライアントからデータが送られてきた時に実行される

    '受信データをファイルに書き込む
    ReDim b_Data(bytesTotal - 1)
    Winsock1.GetData b_Data
    Put #hFile, , b_Data
    cnt = cnt + 1
    Msg_Wite bytesTotal & "バイト書込み " & cnt
    
    '受信トータルバイト計算
    T_Byte = T_Byte + bytesTotal
    
End Sub

Private Sub Winsock1_Close()
'イベント***クライアントから切断された時に実行される

    Winsock1.Close
    
    Msg_Wite T_Byte & "バイト　書込み ALL"
    Msg_Wite "切断されました"
    
    'ファイルクローズ
    Close hFile
    
End Sub

Private Sub Msg_Wite(msg)
    Me.Text2 = msg & vbCrLf & Me.Text2
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, _
                            ByVal Scode As Long, ByVal Source As String, _
                            ByVal HelpFile As String, ByVal HelpContext As Long, _
                            CancelDisplay As Boolean)
    Winsock1.Close
    MsgBox Description, vbOKOnly
    
End Sub

-------------------------------------------
＜FTP 送信＞

Option Explicit

Dim svRemotePort As Long
Dim svRemoteAddress As String
Dim clLocalPort As Long
Dim clLocalAddress As String

Dim LocalDataPath As String
Dim DataLen As Double

Dim send_cntLen As Double
Dim send_kaisu As Double
Dim send_maxLen As Double

Dim LocalData() As Byte
Dim hFile As Integer
Dim F_ST As Double
Dim F_ED As Double

Dim cnt As Integer

Private Sub Form_Load()
    clLocalPort = 0
    Me.Command3.Enabled = False
    send_maxLen = 4096
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Winsock1.Close
End Sub

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
    On Error GoTo err_end
    Dir1.Path = Drive1.Drive
    Exit Sub
err_end:
    MsgBox "選択エラー"
End Sub

Private Sub File1_Click()
    Me.Text1.Text = File1.FileName
    LocalDataPath = File1.Path & "" & File1.FileName
End Sub

Private Sub Command1_Click()
'Conect
    '送り先アドレス、ポート設定
    svRemoteAddress = Text4.Text
    svRemotePort = Text5.Text
    
    If IsNumeric(Text6.Text) Then
        F_ST = Text6.Text
    End If
    If IsNumeric(Text7.Text) Then
        F_ED = Text7.Text
    End If
    
    With Winsock1
         'ソケットをTCPに設定
        .Protocol = sckTCPProtocol
        'ローカルポートの設定
        .LocalPort = clLocalPort
        'リモートポートの設定
        .RemotePort = svRemotePort
        'リモートIPの設定
        .RemoteHost = svRemoteAddress
        'コネクトする
        .Connect
    End With
    
    With Winsock1
        '接続データを表示
        Msg_Wite ("LocalIP    =" + CStr(.LocalIP))
        Msg_Wite ("Local Port =" + CStr(.LocalPort))
        Msg_Wite ("RemoteIP   =" + CStr(.RemoteHostIP))
        Msg_Wite ("Remote Port=" + CStr(.RemotePort))
        Msg_Wite ("Conect")
    End With
    
    send_cntLen = F_ST - 1
    Command3.Enabled = True
    cnt = 0
End Sub

Private Sub Command2_Click()
'ポートClose
    Winsock1.Close
    Me.Command3.Enabled = False

    Msg_Wite ("Close")

End Sub

Private Sub Winsock1_Connect()
'イベント
    Msg_Wite ("接続しました")

    With Winsock1
        '接続データを表示
        Msg_Wite ("LocalIP    =" + CStr(.LocalIP))
        Msg_Wite ("Local Port =" + CStr(.LocalPort))
        Msg_Wite ("RemoteIP   =" + CStr(.RemoteHostIP))
        Msg_Wite ("Remote Port=" + CStr(.RemotePort))
        
    End With

End Sub

Private Sub Winsock1_Close()
'イベント***相手から切断された時に実行される

    Winsock1.Close
    
    Msg_Wite ("切断されました")
    Me.Command3.Enabled = False
    
    '一度クローズしてから、再度接続する
    'Command1_Click

End Sub

Private Sub Command3_Click()
'Send

    If Me.Text1.Text = "" Then
        MsgBox "ファイルを指定してください。"
        Exit Sub
    End If
    
    '送信バイト指定を受取る
    send_maxLen = Text2.Text
    
    'ファイル読み込み

    hFile = FreeFile
    Open LocalDataPath For Binary As #hFile
    
    '対象データのバイト数を得る。
    DataLen = LOF(hFile)
    
    '対象データのバイト数＜指定最終バイトの場合
    If DataLen <F_ED Then (F_ED - F_ST + 1) Then
        DataLen = F_ED - F_ST + 1
    End If
    Msg_Wite (DataLen & "バイトALL / 対象=" & DataLen - send_cntLen)
    
    'ファイルを読込み・転送
    Get_File_Send

End Sub

Private Sub Get_File_Send()
    
    '読込み残りデータ計算
    If DataLen <send_maxLen + send_cntLen Then 0 Then
        '終了位置指定がある場合は、開始位置を指定しながら
        '指定バイト分ずつ読込む。
        ReDim LocalData(send_maxLen - 1)
        Get #hFile, send_cntLen + 1, LocalData
    Else
        '終了位置指定がない場合は、指定バイトサイズを先頭から
        '指定バイト分ずつ読込む。
        ReDim LocalData(send_maxLen - 1)
        Get #hFile, , LocalData
    End If
    'データ送信
    Winsock1.SendData LocalData
    
End Sub

Private Sub Winsock1_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
'プログレスバーの処理
    ProgressB1ar1.Value = ((DataLen - bytesRemaining) / DataLen) * 100
End Sub

Private Sub Winsock1_SendComplete()
'分割データが送り終わるまで、send を繰り返す。
    cnt = cnt + 1
    Msg_Wite (send_maxLen & "バイト 送信 " & cnt)
    
    '送信済みバイト計算
    send_cntLen = send_cntLen + send_maxLen
    
    '残りデータがあれば繰返す。
    If DataLen > send_cntLen Then
    
        'ファイルを読込み・転送
        Get_File_Send
        
      Else
      
        '送り終わったらクローズ処理
        Winsock1.Close
        'ファイルクローズ
        Close #hFile
        
        Msg_Wite (send_cntLen & "バイト　送信完了 ")
        Msg_Wite ("Winsock1.Close ")
        
        Me.Command3.Enabled = False
    End If
    
End Sub

Private Sub Msg_Wite(msg)
'メッセージ出力
    Me.Text3 = msg & vbCrLf & Me.Text3
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, _
                           ByVal Scode As Long, ByVal Source As String, _
                           ByVal HelpFile As String, ByVal HelpContext As Long, _
                           CancelDisplay As Boolean)
'Winsok　エラー処理
    MsgBox Description, vbOKOnly
    Winsock1.Close
    Me.Command3.Enabled = False
End Sub

日	月	火	水	木	金	土
			1	2	3	4
5	6	7	8	9	10	11
12	13	14	15	16	17	18
19	20	21	22	23	24	25
26	27	28	29	30	31

	ブログを読むだけ。毎月の訪問日数に応じてポイント進呈
	【コメント募集中】今年、福袋を買いましたか？
	訪問者数に応じてdポイント最大1,000pt当たる！
	dポイントが当たる！無料『毎日くじ』

アルツの備忘録

最近、年のせいで物忘れが激しい。
そこで、いろんなことをここに記録して行きたいと思います。