Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports Microsoft.VisualBasic
'''
''' 本代码由MysticBoy 于 2006-01-26编写，2-20编写一下说明以及注释 。
''' 文件传输测试窗体，你需要添加两个按钮。不要重命名直接使用默认名称。如果需要
''' 您需要修改一下的代码。
'''
'''
Public Class frmTran
Dim WithEvents mtl As New FileTransmit
'''
''' 按钮1的单击时间内为启动接受
'''
'''
'''
'''
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
'''
''' 文件传输类的传输过程事件
'''
'''
'''
Private Sub mtl_Progress(ByVal size As Long) Handles mtl.Progress
Me.Text = size '显示文件传输类的消息
My.Application.DoEvents() '释放CPU时间
End Sub
'''
''' 按钮二为发送一个文件。
'''
'''
'''
'''
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 WhyKiller(boby vox).mpg\"))
'我们发送一个文件到 127.0.0.1 的 1123端口。
End Sub
End Class
'''
''' 文件传输类，包括发送和接收。
'''
'''
Class FileTransmit
'''
''' 发送文件
'''
'''
'''
'''
'''
'''如果发送成功返回真。
'''
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:111333222.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
'''
''' 接受过程，在该事件中您可以编写反映接受情况的代码
'''
'''
'''
Public Event Progress(ByVal size As Long)
'''
''' 接受文件
'''
'''
'''
'''
'''
'''
'''如果成功接受返回真
'''
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
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports Microsoft.VisualBasic
'''
''' 本代码由MysticBoy 于 2006-01-26编写，2-20编写一下说明以及注释 。
''' 文件传输测试窗体，你需要添加两个按钮。不要重命名直接使用默认名称。如果需要
''' 您需要修改一下的代码。
'''
'''
Public Class frmTran
Dim WithEvents mtl As New FileTransmit
'''
''' 按钮1的单击时间内为启动接受
'''
'''
'''
'''
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
'''
''' 文件传输类的传输过程事件
'''
'''
'''
Private Sub mtl_Progress(ByVal size As Long) Handles mtl.Progress
Me.Text = size '显示文件传输类的消息
My.Application.DoEvents() '释放CPU时间
End Sub
'''
''' 按钮二为发送一个文件。
'''
'''
'''
'''
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 WhyKiller(boby vox).mpg\"))
'我们发送一个文件到 127.0.0.1 的 1123端口。
End Sub
End Class
'''
''' 文件传输类，包括发送和接收。
'''
'''
Class FileTransmit
'''
''' 发送文件
'''
'''
'''
'''
'''
'''
'''
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:111333222.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
'''
''' 接受过程，在该事件中您可以编写反映接受情况的代码
'''
'''
'''
Public Event Progress(ByVal size As Long)
'''
''' 接受文件
'''
'''
'''
'''
'''
'''
'''
'''
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
浙公网安备 33010602011771号