VB实现局域网内的文件传输

 

• 　为了设计统一和用户操作方便，我们希望将服务端与客户端融合在一起，形成一个程序，这样用户理解起来，更加直观一点（其实这样做也是为了方便调试，大家可以在本机上测试，自己传文件给自己）。所以，我们在程序中需要使用两个Winsock控件，一个负责监听，一个负责发送，当发送端连接成功以后，便选择一个待发送的文件（可以是任意二进制文件），接着将文件名和文件字节长度发送给接收端，接收端收到这个消息以后，将文件名和文件长度解析出来，然后通知发送端可以开始发送文件；发送端读到这个消息之后，将文件流以字节的形式发送到接收端，接收端收到后，将二进制流回写，保存成文件即可。这里要注意两点，一个是由于Winsock每次最大传输8K的内容，所以需要将文件分解，每次传输固定数目的字节流，这样发送和接收时都可以根据这个数目来判断文件传输的进程，一旦字节流数目等于文件的大小，就需要关闭相应的文件句柄；另一点是由于我只使用一个Winsock控件接收，接收文本时需要注意要将UNICODE转码，解析成可识别的信息。
  
  
  
  源代码
  
  '下面的代码既是服务器又是客户端
  
  '采用应答式发送方式
  
  '自动拆分文件，包括2进制
  
  
  
  Option EXPlicit
  
  'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  
  
  
  Dim mybyte() As Byte '发送方数组
  
  
  
  Const filecomesMSG = "a file is coming " '有文件到来
  
  Const RemoteIsReadyMSG = "sender is ready " '准备好了
  
  Const FileisOverMSG = "the file is ended" '文件完毕
  
  Const RemoteDenyMSG = "the user canceled" '用户取消
  
  Const filecountMSG = "the file lengh is" '文件长度
  
  Const RecevieIsReadyMSG = "Receiver is ready " '准备接收
  
  
  
  Dim arrdata() As Byte '收到的信息
  
  Dim filesave As Integer '保存文件的句柄
  
  Dim filehandle As Integer '发送方文件的句柄
  
  Dim FileSize As Double '文件的大小
  
  
  
  Dim Sendbyte As Long
  
  Dim Receivebyte As Long
  
  
  
  Dim MyLocation As Double
  
  Dim myMSG As String '消息
  
  Dim FileisOver As Boolean '文件是否已经完毕
  
  
  
  Const ReceivePort = 7905
  
  Const BUFFER_SIZE = 5734
  
  

• Timer2.Enabled = True
  
  End Sub
  
  
  
  Private Sub cmdsend_Click()
  
  
  
  On Error GoTo errorhandle
  
  
  
  With CommonDialog1
  
  .CancelError = True
  
  .DialogTitle = "选择您要传送的文件"
  
  .Filter = "All Files (*.*)*.*"
  
  .ShowOpen
  
  End With
  
  
  
  filehandle = FreeFile
  
  Open CommonDialog1.FileName For Binary Access Read As #filehandle
  
  
  
  cmdSend.Enabled = False
  
  
  
  FileSize = CDbl(FileLen(CommonDialog1.FileName))
  
  
  
  Label1.Caption = "等待回应>>>"
  
  MsgBox ("选择的文件大小为 " & LOF(filehandle) & " 字节")
  
  
  
  If WinsockSend.State = sckConnected Then
  
  WinsockSend.SendData filecomesMSG & CommonDialog1.FileName '发送发出文件信息
  
  End If
  
  
  
  Exit Sub
  
  
  
  errorhandle:
  
  cmdSend.Enabled = True
  
  MsgBox ("你没有选择一个文件！")
  
  
  
  End Sub
  
  
  
  
  
  Private Sub Form_Load()
  
  
  
  WinsockReceive.LocalPort = ReceivePort
  
  WinsockReceive.Listen
  
  
  
  FileisOver = True
  
  
  
  Label1.Caption = "准备传输>>>"
  
  
  
  End Sub
  
  
  
  Public Function SendChunk()
  
  
  
  Dim mybytesize As Long
  
  
  
  If WinsockSend.State <> sckConnected Then Exit Function
  
  

• mybytesize = BUFFER_SIZE
  
  
  
  If LOF(filehandle) - Loc(filehandle) < BUFFER_SIZE Then mybytesize = (LOF(filehandle) - Loc(filehandle))
  
  
  
  ReDim mybyte(0 To mybytesize - 1)
  
  
  
  Get #filehandle, , mybyte
  
  
  
  WinsockSend.SendData mybyte
  
  
  
  Sendbyte = Sendbyte + mybytesize
  
  
  
  ProgressBar1.Value = Int((100 / FileSize) * Sendbyte)
  
  
  
  If Sendbyte >= FileSize Then
  
  FileisOver = True
  
  WinsockSend.SendData FileisOverMSG
  
  End If
  
  
  
  End Function
  
  
  
  Private Sub Timer2_Timer()
  
  If WinsockSend.State = sckConnected Then
  
  
  
  Timer2.Enabled = False
  
  
  
  cmdConnect.Enabled = False
  
  
  
  ElseIf WinsockSend.State <> 1 And WinsockSend.State <> 6 And WinsockSend.State <> 7 And WinsockSend.State <> 8 And WinsockSend.State <> 9 Then
  
  
  
  WinsockSend.Connect txtHost.Text, ReceivePort
  
  
  
  ElseIf WinsockSend.State = 8 Or WinsockSend.State = 9 Then
  
  
  
  WinsockSend.Close
  
  End If
  
  
  
  
  
  End Sub
  
  
  
  Private Sub WinsockReceive_ConnectionRequest(ByVal requestID As Long)
  
  
  
  If WinsockReceive.State <> sckClosed Then WinsockReceive.Close
  
  
  
  WinsockReceive.Accept requestID
  
  
  
  
  
  End Sub
  
  
  

• Private Sub WinsockReceive_DataArrival(ByVal bytesTotal As Long)
  
  
  
  ReDim arrdata(0 To bytesTotal - 1)
  
  
  
  WinsockReceive.GetData arrdata, vbByte + vbArray
  
  
  
  myMSG = StrConv(arrdata, vbUnicode) '二进制转为字符串
  
  
  
  Select Case Mid(myMSG, 1, 17)
  
  
  
  Case filecomesMSG '这些消息发送方和接受方都可收到
  
  '显示保存对话框
  
  On Error GoTo errorhandle
  
  CommonDialog1.FileName = Mid(myMSG, 17, Len(myMSG))
  
  CommonDialog1.DialogTitle = "选择保存文件的路径"
  
  CommonDialog1.ShowSave
  
  filesave = FreeFile
  
  
  
  Receivebyte = 0
  
  cmdSend.Enabled = False
  
  WinsockReceive.SendData RecevieIsReadyMSG
  
  Case FileisOverMSG
  
  Close #filesave
  
  
  
  MsgBox ("文件传输成功！") '大家一起处理
  
  
  
  cmdConnect.Enabled = True
  
  
  
  cmdSend.Enabled = True
  
  
  
  Label1.Caption = "准备传输>>>"
  
  
  
  ProgressBar1.Value = 0
  
  
  
  WinsockReceive.SendData FileisOverMSG
  
  
  
  WinsockReceive.Close
  
  
  
  WinsockReceive.Listen
  
  
  
  Case filecountMSG
  
  FileSize = Mid(myMSG, 18, Len(myMSG))
  
  Open CommonDialog1.FileName For Binary Access Write As #filesave
  
  WinsockReceive.SendData RemoteIsReadyMSG
  
  Label1.Caption = "文件准备传输！"
  
  FileisOver = False
  
  

• Case Else
  
  If Receivebyte < FileSize Then
  
  Receivebyte = Re