vb 利用Winsock进行文件传输源码

[weichaichang]

要求：
1、采用客户服务器模式或点对点模式。不要客户端和服务器端写在一个程序里的。
2、传输文件的选取要用Dialogcommon，不要指定路径的。
3、局域网能用就行，不需要外网，代码越简单越好。
在此先感谢，毕业设计急用。

[weichaichang]

我在网上找了很长时间了，找到的90%都是下边这个程序，且不能用。
''下面的代码既是服务器又是客户端

''采用应答式发送方式

''自动拆分文件，包括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

[of123]

自己写吧。并不难。

[weichaichang]

欢迎大家广泛回帖，还可以再加分的。

[m60a1]

LZ,你哪儿找来的代码,,代码质量很差,,就你那个功能,根本不需要这么多代码


就说这么多.....

[weichaichang]

在百度搜的。可以找到n多个一模一样的如上代码。郁闷。有时间的话，帮忙找啊。

[weichaichang]

麻烦高人们广发代码啊

[free1688]

相关的问题，多观察观察

[ithorsewei]

好东西，。逛定

[weichaichang]

没高人发，我自己花了两个小时写了一个，已经上传到下载区了。感兴趣的到下载区下载吧。还有一个问题，就是速度慢啊。我在局域网测试过，很慢的。但稳定。

[whmgr]

我想知道解决的方法和代码。