Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports Microsoft.VisualBasic
''' <summary>
''' 本代码由MysticBoy 于 2006-01-26编写，2-20编写一下说明以及注释 。
''' 文件传输测试窗体，你需要添加两个按钮。不要重命名直接使用默认名称。如果需要
''' 您需要修改一下的代码。
''' </summary>
''' <remarks></remarks>
Public Class frmTran
Dim WithEvents mtl As New FileTransmit
''' <summary>
''' 按钮1的单击时间内为启动接受
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Debug.Print(mtl.ReceiveFile(My.Application.Info.DirectoryPath)) '按钮一 ，这里准备接受文件
'保存路径为当前程序目录
End Sub
''' <summary>
''' 文件传输类的传输过程事件
''' </summary>
''' <param name="size">已经传输的大小</param>
''' <remarks></remarks>
Private Sub mtl_Progress(ByVal size As Long) Handles mtl.Progress
Me.Text = size '显示文件传输类的消息
My.Application.DoEvents() '释放CPU时间
End Sub
''' <summary>
''' 按钮二为发送一个文件。
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
MsgBox(mtl.SendFile("127.0.0.1", 1123, "E:\影视&音乐\韩国辣妹4th Why\Killer(boby vox).mpg"))
'我们发送一个文件到 127.0.0.1 的 1123端口。
End Sub
End Class
''' <summary>
''' 文件传输类，包括发送和接收。
''' </summary>
''' <remarks></remarks>
Class FileTransmit
''' <summary>
''' 发送文件
''' </summary>
''' <param name="RemoteHost">接受文件的主机地址</param>
''' <param name="RemotePort">接受文件的主机的端口</param>
''' <param name="FileName">要发送的文件的完整路径</param>
''' <param name="e">错误对象。发生错误时返回 </param>
''' <returns>如果发送成功返回真。</returns>
''' <remarks></remarks>
Function SendFile(ByVal RemoteHost As String, ByVal RemotePort As Integer, ByVal FileName As String, Optional ByRef e As Exception = Nothing) As Boolean
Try
Dim client As New TcpClient(RemoteHost, RemotePort) '创建一客户端
Dim stream As NetworkStream = client.GetStream() '获取流
Dim data As Byte() = System.Text.Encoding.Default.GetBytes("file") '编码发送握手协议的命令通知主机接受文件
stream.Write(data, 0, data.Length) '发送
Dim cmd As String
data = New Byte(10) {} '数组重新定义
Dim bytes As Integer = stream.Read(data, 0, data.Length) '读取回应信息。等待。。。。
cmd = System.Text.Encoding.Default.GetString(data, 0, bytes) '读取完后解码回应信息。
If cmd = "filename" Then '如果服务器索要文件名。
data = System.Text.Encoding.Default.GetBytes(My.Computer.FileSystem.GetFileInfo(FileName).Name)
'编码文件名。不给路径。如：c:\111\333\222.txt 给出 222.txt
stream.Write(data, 0, data.Length) '发送文件名
Else '如果不是约定请求。返回。说明协议不正确。
Return False
End If
data = New Byte(10) {} '数组重新定义
bytes = stream.Read(data, 0, data.Length) '读取数据
cmd = System.Text.Encoding.Default.GetString(data, 0, bytes) '解码响应信息
If cmd = "filedata" Then '如果服务器要求文件数据。
data = My.Computer.FileSystem.ReadAllBytes(FileName) '读取文件内容。
stream.Write(data, 0, data.Length) '写入流。 发送。
Else
Return False '协议不正确
End If
client.Close() '关闭
Return True '成功。返回真
Catch ex As Exception
e = ex '返回错误信息
Return False
End Try
End Function
''' <summary>
''' 接受过程，在该事件中您可以编写反映接受情况的代码
''' </summary>
''' <param name="size">已经接受了的文件大小。</param>
''' <remarks></remarks>
Public Event Progress(ByVal size As Long)
''' <summary>
''' 接受文件
''' </summary>
''' <param name="Path">文件保存路径。</param>
''' <param name="LocalIPAddress">本机IP地址，在。NET中似乎是必须的。</param>
''' <param name="LocalPort">侦听端口</param>
''' <param name="Rename">如果文件存在是不是需要重名名原有文件</param>
''' <param name="e">异常对象，如果有错误可以使用该异常对象返回</param>
''' <returns>如果成功接受返回真</returns>
''' <remarks></remarks>
Public Function ReceiveFile( _
ByVal Path As String, _
Optional ByVal LocalIPAddress As String = "127.0.0.1", _
Optional ByVal LocalPort As Integer = 1123, _
Optional ByVal Rename As Boolean = True, _
Optional ByRef e As Exception = Nothing) As String
Dim nType As Integer
Dim FileName As String = Nothing
Dim client As TcpClient
Dim server As TcpListener
server = Nothing
Path = IIf(Right(Path, 1) = "\", Left(Path, Path.Length - 1), Path) '计算路径，防止多余的斜杠
'如果路径后面带有"\"，取出，以下文件路径计算中，包含了"\"
Try
Dim localAddr As IPAddress = IPAddress.Parse(LocalIPAddress) '指定本机IP地址
'不支持DNS，仅支持字符串，ipv4使用点分隔ipv6使用冒号16进制
server = New TcpListener(localAddr, LocalPort) '创建一个侦听对象
server.Start() '启动侦听
Dim bytes(65535) As Byte '接受缓冲大小65535字节，VB6中的winsock为 8191。同等环境传输速度不取决缓冲区大小
Dim data As String = Nothing
While True
'如果有必要呢，你可以使用线程池来实现多个连接同步等待。
'这需要把While中的代码放在一个sub 中,相关线程池的操作请参考MSDN
'建议:最好使用线程池 ，至少我认为线程池是最好管理的。
client = server.AcceptTcpClient() '等待客户连接
data = Nothing
Dim stream As NetworkStream = client.GetStream() '接通后获取数据流
Dim i As Integer
i = stream.Read(bytes, 0, bytes.Length) '读取到缓冲区，i返回读取的字节数目
While i <> 0 '如果读取到的数据大小为0就退出循环
Dim cmd As String
If bytes.Length > 0 Then
Select Case nType
Case 0
cmd = System.Text.Encoding.Default.GetString(bytes, 0, i) '编码数据
'把接受到的数据编码为本机可识别字符。该方法有效支持本机区域设置。
Select Case cmd '为扩展此函数，这里使用select语句。
Case "file" '如果接受到的命令是file .说明客户请求发送文件 。
Dim msg As Byte() = System.Text.Encoding.ASCII.GetBytes("filename")
stream.Write(msg, 0, msg.Length) '此时，向客户询问文件名。以便确认是什么文件
nType = 1 '设置下一个操作类型为1，既取得文件名称
End Select
Case 1
FileName = System.Text.Encoding.Default.GetString(bytes, 0, i)
'把接受到的数据编码为本机可识别字符。该方法有效支持本机区域设置。
If My.Computer.FileSystem.FileExists(Path & "\" & FileName) = True Then
If Rename = True Then '如果重命名为真，则在名字空间前加"renamed_"
Try
' 对于重名名，可能这个方法并不是最好的，建议你写一个算法。或者干脆让用户来决定保存为什么文件。
My.Computer.FileSystem.RenameFile(Path & "\" & FileName, "renamed_" & Now.Ticks & "_" & FileName)
Catch ex As Exception
e = ex
Return Nothing '如果无法重命名。返回
End Try
Else '如果用户不重命名，则尝试删除。如果删除不成功。返回
Try '如果该文件已存在，则删除该文件。
My.Computer.FileSystem.GetFileInfo(Path & "\" & FileName).Delete()
Catch ex As Exception
e = ex '如果文件无法删除，返回
Return Nothing
End Try
End If
End If
Dim msg As Byte() = System.Text.Encoding.ASCII.GetBytes("filedata")
'按照编译字符为数组
stream.Write(msg, 0, msg.Length) '写入流。同vb6中的 ws.senddata :doevents
nType = 2 '操作类型为2时，收到的数组写入文件中。
Case 2
ReDim Preserve bytes(i - 1) '定义i个字节，0到(i-1)为i个
'使用重定义保留值缩小数组
My.Computer.FileSystem.WriteAllBytes(Path & "\" & FileName, _
bytes, True) '写入到文件中
RaiseEvent Progress(My.Computer.FileSystem.GetFileInfo _
(Path & "\" & FileName).Length)
'接受过程
End Select
End If
ReDim bytes(65535) '重定义，清除旧数据。该操作建议.
Try
i = stream.Read(bytes, 0, bytes.Length) '从缓冲区中读取数据
Catch ex As Exception
e = ex
Return Nothing
End Try
End While
nType = 0 '操作类型设置为空
client.Close() '关闭客户端
Exit While '退出无限制的等待
End While
Catch ex As SocketException
e = ex
Return Nothing
Finally
server.Stop() '服务停止
End Try
Return Path & "\" & FileName '返回文件具体路径，来表示文件接受成功。
End Function
End Class