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 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 = 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

本程序在 WinXPSP1+VB6 和 Win2000SP4+VB6 下面调试成功。

Published At
Categories with Web编程
Tagged with
comments powered by Disqus