我的想法是实现多个用户能与服务器传输文件,程序的结果是只连接到服务器(显示客户端ip)但是不能传输文件,请那位高手帮忙看看程序,谢谢!!!!!!!
服务器端程序:Option Explicit
'服务器消息
Dim sServerMSG As String
Dim myMSG As String
'请求ID
Dim i As IntegerConst filecomesMSG = "file coming" '有文件到
Const senderisreadyMSG = "sender is ready" '发送方准备好了
Const fileisoverMSG = "file end" '文件完毕
Const receiverdenyMSG = "sender cancle" '发送方取消
Const filelengthMSG = "the file length is" '文件长度
Const receiverisreadyMSG = "receiver is ready" '准备接收Dim mybyte() As Byte
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 fileisover As Boolean '文件是否完毕Private Sub Form_Load()
wsServe(0).LocalPort = 2048
sServerMSG = "Listening to port:" & wsServe(0).LocalPort
'添加消息
lstinf.AddItem (sServerMSG)
wsServe(0).Listen
End SubPrivate Sub wsServe_Close(Index As Integer)
'关闭消息
sServerMSG = "connection closed:" & wsServe(i).RemoteHostIP
'添加消息
lstinf.AddItem (sServerMSG)
'关闭端口
wsServe(i).Close
'清空内存
Unload wsServe(i)
i = i - 1
End SubPrivate Sub wsServe_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim sip As String
sip = wsServe(0).RemoteHostIP '获得登录者的IP地址
i = 1
Do While i <= wsServe.ubound '检查是否已经有该地址的记录
If wsServe(i).RemoteHostIP = sip Then '如有,不必加载新的控件
wsServe(i).Accept requestID
wsServe(i).SendData receiverisreadyMSG
Exit Sub
End If
i = i + 1
Loop
Load wsServe(i) '否则,加载新的控件
ReDim sending(1 To i) '增加一个发送状态标志
wsServe(i).Accept requestID
wsServe(i).SendData receiverisreadyMSG
End SubPrivate Sub wsServe_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'获取客户端数据sServerMSG = "Recevied from:" & wsServe(0).RemoteHostIP & ""
lstinf.AddItem (sServerMSG)
ReDim arrdata(0 To bytesTotal - 1)
wsServe(i).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
wsServe(i).SendData receiverisreadyMSG
Case fileisoverMSG
Close #filesave
MsgBox ("文件传输成功!")
wsServe(i).SendData fileisoverMSG
wsServe(i).Close
i = i - 1
wsServe(0).Listen
Case filelengthMSG
filesize = Mid(myMSG, 18, Len(myMSG))
Open CommonDialog1.FileName For Binary Access Write As #filesave
wsServe(i).SendData receiverisreadyMSG
fileisover = False
Case Else
If receivebyte < filesize Then
receivebyte = receivebyte + bytesTotal
Put #filesave, , arrdata
wsServe(i).SendData receiverisreadyMSG
ProgressBar1.Value = Int((100 / filesize) * receivebyte)
End If
End Select
Exit Sub
errorhandle:
wsServe(i).SendData receiverdenyMSGEnd Sub
客户端程序:
Option Explicit
Dim mysend() As Byte '发送方数组
Const filecomesMSG = "file coming" '有文件到
Const senderisreadyMSG = "sender is ready" '发送方准备好了
Const fileisoverMSG = "file end" '文件完毕
Const sendercancleMSG = "sender cancle" '发送方取消
Const filelengthMSG = "the file length is" '文件长度
Const receiverisreadyMSG = "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 Block_size = 6144
Private Sub cmdCancle_Click()
Winsock1.Close
Unload Form1
End SubPrivate Sub cmdConnect_Click()
'关闭winsock控件
Winsock1.Close
Do
DoEvents
Loop While Winsock1.State <> sckClosed
'联接服务器
Winsock1.Connect txtServe.Text, txtPort.Text
cmdConnect.Enabled = False
'If Winsock1.State = sckConnected Then
'cmdConnect.Enabled = False
'ElseIf Winsock1.State <> sckClosed Then
' Winsock1.Connect txtServe, txtPort
' ElseIf Winsock1.State = sckClosing Or Winsock1.State = sckError Then
' Winsock1.Close
'End If
End SubPrivate Sub cmdSend_Click()
'On Error GoTo errorhandle
With CommonDialog1
.CancelError = True
.DialogTitle = "请选择您要传送的文件!"
.Filter = "AllFiles(*.*)|*.*"
.ShowOpen
End Withfilehandle = FreeFile
Open CommonDialog1.FileName For Binary Access Read As #filehandlecmdSend.Enabled = False
filesize = CDbl(FileLen(CommonDialog1.FileName))
MsgBox ("您选择的文件大小为" & LOF(filehandle) & "字节")
If Winsock1.State = sckConnected Then
Winsock1.SendData filecomesMSG & CommonDialog1.FileName '发送文件信息
End If
'Exit Sub
'errorhandle:
'cmdSend.Enabled = True
'MsgBox ("还没有选择文件!")
End SubPrivate Function Sendfile()
Dim sendsize As Long
If Winsock1.State <> sckConnected Then Exit Function
sendsize = Block_size
If LOF(filehandle) - Loc(filehandle) < Block_size Then sendsize = (LOF(filehandle) - Loc(filehandle))
ReDim mysend(0 To sendsize - 1)
Get #filehandle, , mysend
Winsock1.SendData mysend
sendbyte = sendbyte + sendsize
ProgressBar1.Value = Int((100 / filesize) * sendbyte)If sendbyte >= filesize Then
fileisover = True
Winsock1.SendData fileisoverMSG
End IfEnd FunctionPrivate Sub Form_Load()
Winsock1.RemotePort = 2048 '服务器的侦听端口
Winsock1.Protocol = sckTCPProtocol '设置为TCP协议
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData myMSG
Select Case myMSG
Case receiverisreadyMSG
Winsock1.SendData filelengthMSG & filesize
fileisover = False
sendbyte = 0
Case senderisreadyMSG
'若文件没有结束,则继续传输
If fileisover = False Then
Sendfile
Else
Winsock1.SendData fileisoverMSG
End If
Case fileisoverMSG
Close #filehandle
MsgBox ("文件传输完成!")
Winsock1.SendData fileisoverMSG
Winsock1.Close
cmdConnect.Enabled = True
ProgressBar1.Value = 0
cmdSend.Enabled = True
Case sendercancleMSG
MsgBox ("用户终止了传输!")
cmdSend.Enabled = True
cmdConnect.Enabled = True
Close #filehandle
End SelectEnd Sub
服务器端程序:Option Explicit
'服务器消息
Dim sServerMSG As String
Dim myMSG As String
'请求ID
Dim i As IntegerConst filecomesMSG = "file coming" '有文件到
Const senderisreadyMSG = "sender is ready" '发送方准备好了
Const fileisoverMSG = "file end" '文件完毕
Const receiverdenyMSG = "sender cancle" '发送方取消
Const filelengthMSG = "the file length is" '文件长度
Const receiverisreadyMSG = "receiver is ready" '准备接收Dim mybyte() As Byte
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 fileisover As Boolean '文件是否完毕Private Sub Form_Load()
wsServe(0).LocalPort = 2048
sServerMSG = "Listening to port:" & wsServe(0).LocalPort
'添加消息
lstinf.AddItem (sServerMSG)
wsServe(0).Listen
End SubPrivate Sub wsServe_Close(Index As Integer)
'关闭消息
sServerMSG = "connection closed:" & wsServe(i).RemoteHostIP
'添加消息
lstinf.AddItem (sServerMSG)
'关闭端口
wsServe(i).Close
'清空内存
Unload wsServe(i)
i = i - 1
End SubPrivate Sub wsServe_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim sip As String
sip = wsServe(0).RemoteHostIP '获得登录者的IP地址
i = 1
Do While i <= wsServe.ubound '检查是否已经有该地址的记录
If wsServe(i).RemoteHostIP = sip Then '如有,不必加载新的控件
wsServe(i).Accept requestID
wsServe(i).SendData receiverisreadyMSG
Exit Sub
End If
i = i + 1
Loop
Load wsServe(i) '否则,加载新的控件
ReDim sending(1 To i) '增加一个发送状态标志
wsServe(i).Accept requestID
wsServe(i).SendData receiverisreadyMSG
End SubPrivate Sub wsServe_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'获取客户端数据sServerMSG = "Recevied from:" & wsServe(0).RemoteHostIP & ""
lstinf.AddItem (sServerMSG)
ReDim arrdata(0 To bytesTotal - 1)
wsServe(i).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
wsServe(i).SendData receiverisreadyMSG
Case fileisoverMSG
Close #filesave
MsgBox ("文件传输成功!")
wsServe(i).SendData fileisoverMSG
wsServe(i).Close
i = i - 1
wsServe(0).Listen
Case filelengthMSG
filesize = Mid(myMSG, 18, Len(myMSG))
Open CommonDialog1.FileName For Binary Access Write As #filesave
wsServe(i).SendData receiverisreadyMSG
fileisover = False
Case Else
If receivebyte < filesize Then
receivebyte = receivebyte + bytesTotal
Put #filesave, , arrdata
wsServe(i).SendData receiverisreadyMSG
ProgressBar1.Value = Int((100 / filesize) * receivebyte)
End If
End Select
Exit Sub
errorhandle:
wsServe(i).SendData receiverdenyMSGEnd Sub
客户端程序:
Option Explicit
Dim mysend() As Byte '发送方数组
Const filecomesMSG = "file coming" '有文件到
Const senderisreadyMSG = "sender is ready" '发送方准备好了
Const fileisoverMSG = "file end" '文件完毕
Const sendercancleMSG = "sender cancle" '发送方取消
Const filelengthMSG = "the file length is" '文件长度
Const receiverisreadyMSG = "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 Block_size = 6144
Private Sub cmdCancle_Click()
Winsock1.Close
Unload Form1
End SubPrivate Sub cmdConnect_Click()
'关闭winsock控件
Winsock1.Close
Do
DoEvents
Loop While Winsock1.State <> sckClosed
'联接服务器
Winsock1.Connect txtServe.Text, txtPort.Text
cmdConnect.Enabled = False
'If Winsock1.State = sckConnected Then
'cmdConnect.Enabled = False
'ElseIf Winsock1.State <> sckClosed Then
' Winsock1.Connect txtServe, txtPort
' ElseIf Winsock1.State = sckClosing Or Winsock1.State = sckError Then
' Winsock1.Close
'End If
End SubPrivate Sub cmdSend_Click()
'On Error GoTo errorhandle
With CommonDialog1
.CancelError = True
.DialogTitle = "请选择您要传送的文件!"
.Filter = "AllFiles(*.*)|*.*"
.ShowOpen
End Withfilehandle = FreeFile
Open CommonDialog1.FileName For Binary Access Read As #filehandlecmdSend.Enabled = False
filesize = CDbl(FileLen(CommonDialog1.FileName))
MsgBox ("您选择的文件大小为" & LOF(filehandle) & "字节")
If Winsock1.State = sckConnected Then
Winsock1.SendData filecomesMSG & CommonDialog1.FileName '发送文件信息
End If
'Exit Sub
'errorhandle:
'cmdSend.Enabled = True
'MsgBox ("还没有选择文件!")
End SubPrivate Function Sendfile()
Dim sendsize As Long
If Winsock1.State <> sckConnected Then Exit Function
sendsize = Block_size
If LOF(filehandle) - Loc(filehandle) < Block_size Then sendsize = (LOF(filehandle) - Loc(filehandle))
ReDim mysend(0 To sendsize - 1)
Get #filehandle, , mysend
Winsock1.SendData mysend
sendbyte = sendbyte + sendsize
ProgressBar1.Value = Int((100 / filesize) * sendbyte)If sendbyte >= filesize Then
fileisover = True
Winsock1.SendData fileisoverMSG
End IfEnd FunctionPrivate Sub Form_Load()
Winsock1.RemotePort = 2048 '服务器的侦听端口
Winsock1.Protocol = sckTCPProtocol '设置为TCP协议
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData myMSG
Select Case myMSG
Case receiverisreadyMSG
Winsock1.SendData filelengthMSG & filesize
fileisover = False
sendbyte = 0
Case senderisreadyMSG
'若文件没有结束,则继续传输
If fileisover = False Then
Sendfile
Else
Winsock1.SendData fileisoverMSG
End If
Case fileisoverMSG
Close #filehandle
MsgBox ("文件传输完成!")
Winsock1.SendData fileisoverMSG
Winsock1.Close
cmdConnect.Enabled = True
ProgressBar1.Value = 0
cmdSend.Enabled = True
Case sendercancleMSG
MsgBox ("用户终止了传输!")
cmdSend.Enabled = True
cmdConnect.Enabled = True
Close #filehandle
End SelectEnd Sub
当客户端到执行完Winsock1.SendData mysend之后,确认发送的mysend有内容。服务器端有没触发wsServe_DataArrival,有就看接受缓存的内容
没有触发,就是连接问题。
Option Explicit
'服务器消息
Dim sServerMSG As String
Dim myMSG As String
'请求ID
Dim i As Integer Const filecomesMSG = "file coming " '有文件到
Const senderisreadyMSG = "sender is ready " '发送方准备好了
Const fileisoverMSG = "file end " '文件完毕
Const receiverdenyMSG = "sender cancle " '发送方取消
Const filelengthMSG = "the file length is" '文件长度
Const receiverisreadyMSG = "receiver is ready " '准备接收Dim mybyte() As Byte
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 fileisover As Boolean '文件是否完毕Private Sub Form_Load()
wsServe(0).LocalPort = 2048
sServerMSG = "Listening to port:" & wsServe(0).LocalPort
'添加消息
lstinf.AddItem (sServerMSG)
wsServe(0).Listen
End SubPrivate Sub wsServe_Close(Index As Integer)
'关闭消息
sServerMSG = "connection closed:" & wsServe(i).RemoteHostIP
'添加消息
lstinf.AddItem (sServerMSG)
'关闭端口
wsServe(i).Close
'清空内存
Unload wsServe(i)
i = i - 1
End SubPrivate Sub wsServe_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim sip As String
sip = wsServe(0).RemoteHostIP '获得登录者的IP地址
i = 1
Do While i <= wsServe.ubound '检查是否已经有该地址的记录
If wsServe(i).RemoteHostIP = sip Then '如有,不必加载新的控件
wsServe(i).Accept requestID
wsServe(i).SendData receiverisreadyMSG
Exit Sub
End If
i = i + 1
Loop
Load wsServe(i) '否则,加载新的控件
ReDim sending(1 To i) '增加一个发送状态标志
wsServe(i).Accept requestID
wsServe(i).SendData receiverisreadyMSG
End SubPrivate Sub wsServe_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'获取客户端数据
Dim str As String
sServerMSG = "Recevied from:" & wsServe(0).RemoteHostIP & ""
lstinf.AddItem (sServerMSG)
ReDim arrdata(0 To bytesTotal - 1)
wsServe(i).GetData arrdata, vbByte + vbArray
myMSG = StrConv(arrdata, vbUnicode) '字符转换
str = Trim(Mid(myMSG, 1, 18))
Select Case str
Case Trim(filecomesMSG)
On Error GoTo errorhandle
CommonDialog1.FileName = Mid(myMSG, 17, Len(myMSG))
CommonDialog1.DialogTitle = "选择保存文件的路径"
CommonDialog1.ShowSave
filesave = FreeFile
receivebyte = 0
wsServe(i).SendData receiverisreadyMSG
Case fileisoverMSG
Close #filesave
MsgBox ("文件传输成功!")
wsServe(i).SendData fileisoverMSG
wsServe(i).Close
i = i - 1
wsServe(0).Listen
Case filelengthMSG
filesize = Mid(myMSG, 19, Len(myMSG))
Open CommonDialog1.FileName For Binary Access Write As #filesave
wsServe(i).SendData receiverisreadyMSG
fileisover = False
Case Else
If receivebyte < filesize Then
receivebyte = receivebyte + bytesTotal
Put #filesave, , arrdata
wsServe(i).SendData receiverisreadyMSG
'‘ProgressBar1.Value = Int((100 / filesize) * receivebyte)
End If
End Select
Exit Sub
errorhandle:
wsServe(i).SendData receiverdenyMSGEnd Sub客户端:
Option Explicit
Dim mysend() As Byte '发送方数组
'Const filecomesMSG = "file coming" '有文件到
'Const senderisreadyMSG = "sender is ready" '发送方准备好了
'Const fileisoverMSG = "file end" '文件完毕
'Const filelengthMSG = "the file length is" '文件长度
'Const receiverisreadyMSG = "receiver is ready" '准备接收 Const filecomesMSG = "file coming " '有文件到
Const senderisreadyMSG = "sender is ready " '发送方准备好了
Const fileisoverMSG = "file end " '文件完毕
Const receiverdenyMSG = "sender cancle " '发送方取消
Const sendercancleMSG = "sender cancle " '发送方取消
Const filelengthMSG = "the file length is" '文件长度
Const receiverisreadyMSG = "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 Block_size = 6144
Private Sub cmdCancle_Click()
Winsock1.Close
Unload Form1
End SubPrivate Sub cmdConnect_Click()
'关闭winsock控件
Winsock1.Close
Do
DoEvents
Loop While Winsock1.State <> sckClosed
'联接服务器
Winsock1.Connect txtServe.Text, txtPort.Text
cmdConnect.Enabled = False
'If Winsock1.State = sckConnected Then
'cmdConnect.Enabled = False
'ElseIf Winsock1.State <> sckClosed Then
' Winsock1.Connect txtServe, txtPort
' ElseIf Winsock1.State = sckClosing Or Winsock1.State = sckError Then
' Winsock1.Close
'End If
End SubPrivate Sub cmdSend_Click()
'On Error GoTo errorhandle
With CommonDialog1
.CancelError = True
.DialogTitle = "请选择您要传送的文件!"
.Filter = "AllFiles(*.*) |*.*"
.ShowOpen
End Withfilehandle = FreeFile
Open CommonDialog1.FileName For Binary Access Read As #filehandlecmdSend.Enabled = False
filesize = CDbl(FileLen(CommonDialog1.FileName))
MsgBox ("您选择的文件大小为" & LOF(filehandle) & "字节")
If Winsock1.State = sckConnected Then
Winsock1.SendData filecomesMSG & CommonDialog1.FileName '发送文件信息
End If
'Exit Sub
'errorhandle:
'cmdSend.Enabled = True
'MsgBox ("还没有选择文件!")
End SubPrivate Function Sendfile()
Dim sendsize As Long
If Winsock1.State <> sckConnected Then Exit Function
sendsize = Block_size
If LOF(filehandle) - Loc(filehandle) < Block_size Then sendsize = (LOF(filehandle) - Loc(filehandle))
ReDim mysend(0 To sendsize - 1)
Get #filehandle, , mysend
Winsock1.SendData mysend
sendbyte = sendbyte + sendsize
ProgressBar1.Value = Int((100 / filesize) * sendbyte)If sendbyte >= filesize Then
fileisover = True
Winsock1.SendData fileisoverMSG
End IfEnd FunctionPrivate Sub Form_Load()
Winsock1.RemotePort = 2048 '服务器的侦听端口
Winsock1.Protocol = sckTCPProtocol '设置为TCP协议
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData myMSG
Select Case myMSG
Case receiverisreadyMSG
Winsock1.SendData filelengthMSG & filesize
fileisover = False
sendbyte = 0
Case senderisreadyMSG
'若文件没有结束,则继续传输
If fileisover = False Then
Sendfile
Else
Winsock1.SendData fileisoverMSG
End If
Case fileisoverMSG
Close #filehandle
MsgBox ("文件传输完成!")
Winsock1.SendData fileisoverMSG
Winsock1.Close
cmdConnect.Enabled = True
'‘ProgressBar1.Value = 0
cmdSend.Enabled = True
Case sendercancleMSG
MsgBox ("用户终止了传输!")
cmdSend.Enabled = True
cmdConnect.Enabled = True
Close #filehandle
End SelectEnd Sub这样就能弹出文件保存框了,还有文件长度等等错误你慢慢调试OK?