当前位置:编程学习 > VB >>

请vb高手帮忙看看我的程序!用vb的winsock控件编写的局域网文件传输的程序,怎么了一直调不通.

我的想法是实现多个用户能与服务器传输文件,程序的结果是只连接到服务器(显示客户端ip)但是不能传输文件,请那位高手帮忙看看程序,谢谢!!!!!!!
服务器端程序:

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 Sub

Private 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 Sub

Private 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 Sub

Private 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 receiverdenyMSG

End 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 Sub

Private 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 Sub

Private Sub cmdSend_Click()
'On Error GoTo errorhandle
With CommonDialog1
 .CancelError = True
 .DialogTitle = "请选择您要传送的文件!"
 .Filter = "AllFiles(*.*)|*.*"
 .ShowOpen
End With

filehandle = FreeFile
Open CommonDialog1.FileName For Binary Access Read As #filehandle

cmdSend.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 Sub

Private 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 If

End Function

Private Sub Form_Load()
Winsock1.RemotePort = 2048 '服务器的侦听端口
Winsock1.Protocol = sckTCPProtocol '设置为TCP协议
End Sub

Private 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 Select

End Sub
--------------------编程问答-------------------- 调试时这样:
  当客户端到执行完Winsock1.SendData mysend之后,确认发送的mysend有内容。服务器端有没触发wsServe_DataArrival,有就看接受缓存的内容
没有触发,就是连接问题。 --------------------编程问答-------------------- 能不能具体点,你以前做过这些项目没有,能不能帮帮忙!我的qq306324423私聊帮忙解决以下.谢谢 --------------------编程问答-------------------- 我帮你初步调试了一下,主要问题是出在交换信息的字串长度上
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 Sub

Private 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 Sub

Private 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 Sub

Private 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 receiverdenyMSG

End 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 Sub

Private 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 Sub

Private Sub cmdSend_Click()
'On Error GoTo errorhandle
With CommonDialog1
 .CancelError = True
 .DialogTitle = "请选择您要传送的文件!"
 .Filter = "AllFiles(*.*) |*.*"
 .ShowOpen
End With

filehandle = FreeFile
Open CommonDialog1.FileName For Binary Access Read As #filehandle

cmdSend.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 Sub

Private 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 If

End Function

Private Sub Form_Load()
Winsock1.RemotePort = 2048 '服务器的侦听端口
Winsock1.Protocol = sckTCPProtocol '设置为TCP协议
End Sub

Private 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 Select

End Sub

这样就能弹出文件保存框了,还有文件长度等等错误你慢慢调试OK?
--------------------编程问答-------------------- 不会,帮顶
补充:VB ,  网络编程
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,