VB SOCKET 实现文件传输

1、VB中使用WinSock控件传送文件 传送文件对于网络编程来说是基本的功能，比如远程控制软件。在编制一个软件时，我从网上下了很多传文件的程序，这些程序提供的传文件功能根本就不能用。传文本还可以，传二进制文件根本就不行。因此，作为一个基本的功能模块，有必要单独介绍一下。 首先，在VB中要传送字符串，你可以这样写： Dim strData As String strData = "Test" Winsock1.SendData strData 但是如果你传送的二进制文件，你还能用String变量来存放吗？从理论上分析是不行的，我也做了实验，确实是不行的。文件虽然可以传，但是接受

2、的文件和发送的不一样，原因可能是二进制文件里可以有任何"字符"，但是不是所有的字符都可以放在String变量里。 除了String类型的变量，VB中其他类型的变量都只有几个字节长，难道一次只能发几个字节吗？那样岂不是要累死机器了！其实，情况没有那么悲观，我们完全可以使用数组来解决这个问题，就是使用byte数组。把要传送的文件都读到数组里，然后发送出去。程序如下： FileName 为要传送的文件名，WinS为发送文件的WinSock控件。这是一个发送端的程序。 Public Sub SendFile(FileName As String, WinS As Winsock)

3、Dim FreeF As Integer '空闲的文件号 Dim LenFile As Long '文件的长度 Dim bytData() As Byte '存放数据的数组 FreeF = FreeFile '获得空闲的文件号 Open FileName For Binary As #FreeFile '打开文件 DoEvents LenFile = LOF(FreeF) '获得文件长度 ReDim bytData(1 To LenFile) '根据文件长度重新定义数组大小 Get #FreeF, , bytData '把文件读入

4、到数组里 Close #FreeF '关闭文件 WinS.SendData bytData '发送数据 End Sub 接受端的程序如下： Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim bytData() As Byte Dim f f = FreeFile Open strFileName For Binary As #f ReDim bytData(1 To bytesTotal) Winsock1.GetData bytData Put #f, i, bytData i = i + bytes

5、Total '保证每次写都是在文件的末尾, i是个全局变量 Close #f End Sub 这里有两个需要注意的地方，ReDim Preserve bytData(1 To LenFile)，下标是从1开始的，如果你写成ReDim bytData( LenFile)，下标就是从0开始了，数组就有LenFile+1长了。LenFile = LOF(FreeFile)中的LOF是获得文件长度的函数，是VB里带的，我见过很多例子用API，或者循环的读直到末尾来获取文件长度，这样都是很麻烦的，使用LOF函数就可以了。 这样的程序，即可以传送文本文件，也可以传送二进制文件。但是你有没有发现这个

6、程序的问题呢？如果我要传送一个50M的文件呢？系统可以为bytData分配50M的内存空间吗？ 于是笔者拿一个50M的文件做实验吧，接收到的文件和原来的文件不一样，比原来的大。问题出在那呢？ 首先，根据文件大小重新定义bytData数组的大小本身就有问题，系统是不可能无限制的给数组分配空间的，即使可以，也会造成系统响应变慢。在传50M文件的时候，系统就跟死机了一样。那么怎么解决这个问题呢，一个自然的想法就是把数据分段传送。程序如下： 发送程序, iPos是个全局变量,初始值为0。这个变量保存着当前数据的位置。Const iMax = 65535是每个数据块的大小。 dim ipos as lo

7、ngConst iMax = 65535Dim FreeF As Integer '空闲的文件号 Dim LenFile As Long '文件的长度 Dim bytData() As Byte '存放数据的数组 FreeF = FreeFile '获得空闲的文件号 Open FileName For Binary As #FreeF '打开文件 DoEvents LenFile = LOF(FreeF) '获得文件长度 If LenFile <= iMax Then '如果要发送的文件小于数据块大小，直接发送 ReDim bytD

8、ata(1 To LenFile) '根据文件长度重新定义数组大小 Get #FreeF, , bytData '把文件读入到数组里 Close #FreeF '关闭文件 WinS.SendData bytData '发送数据 Exit Sub End If '文件大于数据块大小，进行分块发送 Do Until (iPos >= (LenFile - iMax) '发送整块数据的循环 ReDim bytData(1 To iMax) Get #FreeF, iPos + 1, bytData WinS.SendData bytData iP

9、os = iPos + iMax '移动iPos，使它指向下来要读的数据 Loop '这里要注意的是，必须检查文件有没有剩下的数据，如果文件大小正好等于数据块大小的 ' 整数倍，那么就没有剩下的数据了 ReDim bytData(1 To LenFile - iPos) '发送剩下的不够一个数据块的数据 Get #FreeF, iPos + 1, bytData WinS.SendData bytData Close #FreeF 下面是接收端的程序： Private Sub Winsock1_DataArrival(ByVal bytesTotal As Lo

10、ng) Dim bytData() As Byte Dim lLenFile As Long Dim f f = FreeFile Open strFileName For Binary As #f 'strFileName是文件名 lLenFile = LOF(f) ReDim bytData(1 To bytesTotal) Winsock1.GetData bytData If lLenFile = 0 Then 'lLenFile=0表示是第一次打开文件，这里有个问题，就是'如果如果该文件存在的话，就会出错，应该在打开前检查文件是否存在。（这里我省略了） Put

11、 #f, 1, bytData Else Put #f, lLenFile + 1, bytData End If Close #f End SubVB SOCKET 实现文件传输 支持断点续传Option ExplicitConst PACKSIZE As Long = 65536 '每包大小为64KPrivate filepath As StringPrivate filename As StringPrivate filelength As Long '存储文件信息Private data() As BytePrivate pack As LongPrivate send

12、edData As Long '数据缓冲区,文件包数,已传输的数据Private alreadySend As BooleanPrivate cmsStr As StringConst fileD As String = "D:NMSPluginsourceLanBus.rar"Private Sub cmdConnectClient_Click() WinsockSend.Close WinsockSend.Protocol = sckTCPProtocol WinsockSend.RemoteHost = "" Winsoc

13、kSend.RemotePort = 8080 WinsockSend.Connect '连接客户端End SubPrivate Sub cmdSendFile_Click() Open fileD For Binary As #3 filename = "LanBus.rar" filelength = LOF(3) Close #3 WinsockSend.SendData ("NMSP_AYUREADY")End SubPrivate Sub WinsockSend_Connect() StatusBar1.Caption = "

14、已与客户端建立连接。"End Sub'"发送文件"按钮事件代码：Private Sub sendFile() Dim i As Integer Dim j As Long Dim m As Long filepath = fileD StatusBar1.Caption = "向客户端传送文件：" & filename & " 大小为：" & filelength '计算需要传输文件的包数 pack = (filelength - sendedData) PACKSIZE If (fi

15、lelength - sendedData) Mod PACKSIZE) <> 0 Then pack = pack + 1 End If If pack = 0 Then pack = pack + 1 End If '传输文件 Open filepath For Binary As #1 For i = 1 To pack '如果只有一包 If pack = 1 Then Debug.Print "filename=" & filename & " | filelength=" & fileleng

16、th & " | send=" & sendedData ReDim data(filelength - sendedData) '读取数据 For j = sendedData + 1 To filelength Get #1, j, data(j - sendedData) Next '更新已传输文件的数据 sendedData = filelength'发送文件数据 WinsockSend.SendData data '如果是最后一包 ElseIf i + 1 = pack Then '读取最后一包的数据 ReD

17、im data(filelength - sendedData) For j = 1 To filelength - sendedData Get #1, sendedData + j, data(j) Next '发送文件数据 WinsockSend.SendData data '更新已传输文件的数据 sendedData = filelength Exit For Else '将文件数据放到数据缓冲区 ReDim data(PACKSIZE) For m = 1 To PACKSIZE Get #1, sendedData + m, data(j) Next 

18、9;发送文件数据 WinsockSend.SendData data '更新已传输文件的数据 sendedData = sendedData + PACKSIZE End If ProgressBar1.Value = Int(sendedData / filelength) * 100) Next ProgressBar1.Value = Int(sendedData / filelength) * 100) Close #1 alreadySend = False End Sub'客户端反馈Private Sub WinsockSend_DataArrival(ByVal

19、bytesTotal As Long) Dim cmdStr As String WinsockSend.GetData cmdStr, vbString Debug.Print cmdStr If Mid(cmdStr, 1, 13) = "NMSP_IAMREADY" Then '客户端已准备好接收时，要求客户端报告已经接收的文件大小 WinsockSend.SendData "NMSP_RPTCURLE" & filename ElseIf Mid(cmdStr, 1, 13) = "NMSP_REQFILEN"

20、 Then '客户端要求发送文件名称 WinsockSend.SendData "NMSP_FILENAME=" & filename ElseIf Mid(cmdStr, 1, 13) = "NMSP_REQFILES" Then '客户端要求发送文件大小 WinsockSend.SendData "NMSP_FILESIZE=" & filelength 'WinsockSend.GetData send, vbLong ElseIf Mid(cmdStr, 1, 13) = "N

21、MSP_RECEIVED" Then '收到客户端已经接收到的文件大小报告 Debug.Print "客户端已经接收了 " & Mid(cmdStr, 14, Len(cmdStr) sendedData = Mid(cmdStr, 15, Len(cmdStr) If filelength = sendedData Then WinsockSend.SendData "NMSP_SENDDONE" '初始化文件名，大小，已接收大小，遍历是否还需要向别的客户端发送 Let filename = ""

22、Let filelength = 0 Let sendedData = 0 WinsockSend.Close StatusBar1.Caption = "文件发送完毕!" Else Call sendFile End If End IfEnd Sub'= 客户端 =Option ExplicitDim flag As Boolean '设置是否继续接收文件的开关标识Private readyReceive As BooleanPrivate filename As StringPrivate tempfile As StringPrivate realfi

23、le As StringPrivate reveivePath As StringPrivate filelength As Long '存储文件信息Private data() As Byte, received As Long '声明数据缓冲区和已接收的数据Private Sub Form_Load() reveivePath = App.Path & "received" WinsockReceive.Protocol = sckTCPProtocol WinsockReceive.LocalPort = 8080 WinsockReceive

24、.Listen Call initReceiveStateEnd SubPrivate Sub WinsockReceive_Connect() StatusBar1.Caption = "已经连接到服务器"End SubPrivate Sub WinsockReceive_ConnectionRequest(ByVal requestID As Long) If WinsockReceive.State <> 0 Then WinsockReceive.Close End If WinsockReceive.Accept requestID StatusBar

25、1.Caption = "已接受连接请求。"End SubPrivate Sub WinsockReceive_DataArrival(ByVal bytesTotal As Long) Dim j As Long '分别接收传输文件的文件名、文件长度 'WinsockReceive.GetData filename, vbString, bytesTotal - 4 'WinsockReceive.GetData filelength, vbLong '判断指令类型 If readyReceive = False Then Dim cmdS

26、tr As String WinsockReceive.GetData cmdStr, vbString Debug.Print cmdStr If Mid(cmdStr, 1, 13) = "NMSP_AYUREADY" Then '询问是否准备好接收文件 If filename = "" Then WinsockReceive.SendData ("NMSP_REQFILEN") ElseIf filelength = 0 Then WinsockReceive.SendData ("NMSP_REQFILES&

27、quot;) Else WinsockReceive.SendData ("NMSP_IAMREADY") End If ElseIf Mid(cmdStr, 1, 13) = "NMSP_FILENAME" Then '文件名 filename = Mid(cmdStr, 15, Len(cmdStr) WinsockReceive.SendData ("NMSP_REQFILES") ElseIf Mid(cmdStr, 1, 13) = "NMSP_FILESIZE" Then '文件大小 f

28、ilelength = Mid(cmdStr, 15, Len(cmdStr) Debug.Print filelength If (filelength <> 0) ThenWinsockReceive.SendData ("NMSP_IAMREADY") End If ElseIf Mid(cmdStr, 1, 13) = "NMSP_RPTCURLE" Then '服务器端要求提供已经接收的文件大小 '为传输文件设置临时文件 realfile = reveivePath & filename tempfile =

29、 reveivePath & filename & ".td" '返回已接收的数据 'Open realfile For Binary As #1 Open tempfile For Binary As #2 If LOF(2) > 0 Then Input #2, received Debug.Print "received=" & received End If Close #2 WinsockReceive.SendData "NMSP_RECEIVED=" & received readyReceive = True StatusBar1.Caption = "准备接收文件：" & filename & " 大小为：" & filelength ElseIf Mid(cmdStr, 1, 14) = "NMSP_SENDDONE=" Then '服务器发送文件完毕 执行 安装操作 End If Else realfile = reveivePath &