我的想法是实现多个用户能与服务器传输文件,程序的结果是只连接到服务器(显示客户端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

解决方案 »

  1.   

    调试时这样:
      当客户端到执行完Winsock1.SendData mysend之后,确认发送的mysend有内容。服务器端有没触发wsServe_DataArrival,有就看接受缓存的内容
    没有触发,就是连接问题。
      

  2.   

    我帮你初步调试了一下,主要问题是出在交换信息的字串长度上
    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?