vb 局域网 文件传输

Question

给一个简单的代码把，谢谢

Answer 1

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

为了设计统一和用户操作方便，我们希望将服务端与客户端融合在一起，形成一个程序，这样用户理解起来，更加直观一点（其实这样做也是为了方便调试，大家可以在本机上测试，自己传文件给自己）。所以，我们在程序中需要使用两个Winsock控件，一个负责监听，一个负责发送，当发送端连接成功以后，便选择一个待发送的文件（可以是任意二进制文件），接着将文件名和文件字节长度发送给接收端，接收端收到这个消息以后，将文件名和文件长度解析出来，然后通知发送端可以开始发送文件；发送端读到这个消息之后，将文件流以字节的形式发送到接收端，接收端收到后，将二进制流回写，保存成文件即可。这里要注意两点，一个是由于Winsock每次最大传输8K的内容，所以需要将文件分解，每次传输固定数目的字节流，这样发送和接收时都可以根据这个数目来判断文件传输的进程，一旦字节流数目等于文件的大小，就需要关闭相应的文件句柄；另一点是由于我只使用一个Winsock控件接收，接收文本时需要注意要将UNICODE转码，解析成可识别的信息。

源代码

'下面的代码既是服务器又是客户端

'采用应答式发送方式

'自动拆分文件，包括2进制

OptionExplicit

'PrivateDeclareSubSleepLib"kernel32"(ByValdwMillisecondsAsLong)

Dimmybyte()AsByte'发送方数组

ConstfilecomesMSG="afileiscoming"'有文件到来

ConstRemoteIsReadyMSG="senderisready"'准备好了

ConstFileisOverMSG="thefileisended"'文件完毕

ConstRemoteDenyMSG="theusercanceled"'用户取消

ConstfilecountMSG="thefilelenghis"'文件长度

ConstRecevieIsReadyMSG="Receiverisready"'准备接收

Dimarrdata()AsByte'收到的信息

DimfilesaveAsInteger'保存文件的句柄

DimfilehandleAsInteger'发送方文件的句柄

DimFileSizeAsDouble'文件的大小

DimSendbyteAsLong

DimReceivebyteAsLong

DimMyLocationAsDouble

DimmyMSGAsString'消息

DimFileisOverAsBoolean'文件是否已经完毕

ConstReceivePort=7905

ConstBUFFER_SIZE=5734

PrivateSubcmdConnect_Click()

Timer2.Enabled=True

EndSub

PrivateSubcmdsend_Click()

OnErrorGoToerrorhandle

WithCommonDialog1

.CancelError=True

.DialogTitle="选择您要传送的文件"

.Filter="AllFiles(*.*)|*.*"

.ShowOpen

EndWith

filehandle=FreeFile

OpenCommonDialog1.FileNameForBinaryAccessReadAs#filehandle

cmdSend.Enabled=False

FileSize=CDbl(FileLen(CommonDialog1.FileName))

Label1.Caption="等待回应>>>"

MsgBox("选择的文件大小为"&LOF(filehandle)&"字节")

IfWinsockSend.State=sckConnectedThen

WinsockSend.SendDatafilecomesMSG&CommonDialog1.FileName'发送发出文件信息

EndIf

ExitSub

errorhandle:

cmdSend.Enabled=True

MsgBox("你没有选择一个文件！")

EndSub

PrivateSubForm_Load()

WinsockReceive.LocalPort=ReceivePort

WinsockReceive.Listen

FileisOver=True

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

EndSub

PublicFunctionSendChunk()

DimmybytesizeAsLong

IfWinsockSend.State<>sckConnectedThenExitFunction

mybytesize=BUFFER_SIZE

IfLOF(filehandle)-Loc(filehandle)<BUFFER_SIZEThenmybytesize=(LOF(filehandle)-Loc(filehandle))

ReDimmybyte(0Tomybytesize-1)

Get#filehandle,,mybyte

WinsockSend.SendDatamybyte

Sendbyte=Sendbyte+mybytesize

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

IfSendbyte>=FileSizeThen

FileisOver=True

WinsockSend.SendDataFileisOverMSG

EndIf

EndFunction

PrivateSubTimer2_Timer()

IfWinsockSend.State=sckConnectedThen

Timer2.Enabled=False

cmdConnect.Enabled=False

ElseIfWinsockSend.State<>1AndWinsockSend.State<>6AndWinsockSend.State<>7AndWinsockSend.State<>8AndWinsockSend.State<>9Then

WinsockSend.ConnecttxtHost.Text,ReceivePort

ElseIfWinsockSend.State=8OrWinsockSend.State=9Then

WinsockSend.Close

EndIf

EndSub

PrivateSubWinsockReceive_ConnectionRequest(ByValrequestIDAsLong)

IfWinsockReceive.State<>sckClosedThenWinsockReceive.Close

WinsockReceive.AcceptrequestID

EndSub

PrivateSubWinsockReceive_DataArrival(ByValbytesTotalAsLong)

ReDimarrdata(0TobytesTotal-1)

WinsockReceive.GetDataarrdata,vbByte+vbArray

myMSG=StrConv(arrdata,vbUnicode) '二进制转为字符串

SelectCaseMid(myMSG,1,17)

CasefilecomesMSG'这些消息发送方和接受方都可收到

'显示保存对话框

OnErrorGoToerrorhandle

CommonDialog1.FileName=Mid(myMSG,17,Len(myMSG))

CommonDialog1.DialogTitle="选择保存文件的路径"

CommonDialog1.ShowSave

filesave=FreeFile

Receivebyte=0

cmdSend.Enabled=False

WinsockReceive.SendDataRecevieIsReadyMSG

CaseFileisOverMSG

Close#filesave

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

cmdConnect.Enabled=True

cmdSend.Enabled=True

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

ProgressBar1.Value=0

WinsockReceive.SendDataFileisOverMSG

WinsockReceive.Close

WinsockReceive.Listen

CasefilecountMSG

FileSize=Mid(myMSG,18,Len(myMSG))

OpenCommonDialog1.FileNameForBinaryAccessWriteAs#filesave

WinsockReceive.SendDataRemoteIsReadyMSG

Label1.Caption="文件准备传输！"

FileisOver=False

CaseElse

IfReceivebyte<FileSizeThen

Receivebyte=Receivebyte+bytesTotal

Put#filesave,,arrdata

WinsockReceive.SendDataRemoteIsReadyMSG

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

EndIf

EndSelect

ExitSub

errorhandle:

WinsockReceive.SendDataRemoteDenyMSG

cmdConnect.Enabled=True

EndSub

PrivateSubWinsockSend_DataArrival(ByValbytesTotalAsLong)

WinsockSend.GetDatamyMSG

SelectCasemyMSG

CaseRecevieIsReadyMSG

WinsockSend.SendDatafilecountMSG&FileSize

FileisOver=False

Sendbyte=0

CaseRemoteIsReadyMSG

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

IfNotFileisOverThen

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

SendChunk

Else

WinsockSend.SendDataFileisOverMSG

EndIf

CaseFileisOverMSG

'主机处理

Close#filehandle

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

WinsockSend.SendDataFileisOverMSG

WinsockSend.Close

cmdConnect.Enabled=True

ProgressBar1.Value=0

cmdSend.Enabled=True

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

CaseRemoteDenyMSG

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

cmdSend.Enabled=True

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

Close#filehandle

EndSelect

ExitSub

EndSub