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



Private Sub cmdConnect_Click()

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 Aclearcase/" target="_blank" >ccess 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 = Receivebyte + bytesTotal

Put #filesave, , arrdata

WinsockReceive.SendData RemoteIsReadyMSG

ProgressBar1.Value = Int((100 / FileSize) * Receivebyte)

End If

End Select

Exit Sub

errorhandle:

WinsockReceive.SendData RemoteDenyMSG

cmdConnect.Enabled = True



End Sub



Private Sub WinsockSend_DataArrival(ByVal bytesTotal As Long)

WinsockSend.GetData myMSG

Select Case myMSG



Case RecevieIsReadyMSG

WinsockSend.SendData filecountMSG & FileSize

FileisOver = False

Sendbyte = 0



Case RemoteIsReadyMSG

@#如果文件还没有结束，继续传输

If Not FileisOver Then

Label1.Caption = "文件正在被传输>>>"

SendChunk

Else

WinsockSend.SendData FileisOverMSG

End If

Case FileisOverMSG

@#主机处理

Close #filehandle



MsgBox ("文件传输成功！") @#大家一起处理



WinsockSend.SendData FileisOverMSG



WinsockSend.Close



cmdConnect.Enabled = True



ProgressBar1.Value = 0



cmdSend.Enabled = True

Label1.Caption = "准备传输>>>"

Case RemoteDenyMSG

MsgBox ("用户终止了传输！")

cmdSend.Enabled = True

Label1.Caption = "准备传输>>>"

Close #filehandle

End Select

Exit Sub



End Sub

原文转自：http://www.ltesting.net