这些文件传输代码是在网上找的,改了一些,运行时出现了些问题,如果软件向本机IP传输文件时就可以传输,但向其他IP传输文件时就传了一点就不会动了,高手帮帮忙看看哪错了
代码如下:
 ''下面的代码既是服务器又是客户端
    
    ''采用应答式发送方式
    
    ''自动拆分文件,包括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()
    
    frmsend.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 Command4_Click()
Dim ha As String
ha = MsgBox("确认要取消文件传输吗?", vbYesNo)
If ha = vbYes Then
Unload Me
End If
End Sub    Private Sub Form_Load()
    
    
    
    WinsockReceive.LocalPort = ReceivePort
    
    WinsockReceive.Listen
    
    cbxHosts.Text = frmmain.dfip
    
    FileisOver = True
    
    
    
    Label1.Caption = "准备传输>>>"
    
    WinsockSend.RemoteHost = frmmain.dfip
    
    
    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
    
    
        
    ElseIf WinsockSend.State <> 1 And WinsockSend.State <> 6 And WinsockSend.State <> 7 And WinsockSend.State <> 8 And WinsockSend.State <> 9 Then
    
    WinsockSend.Connect cbxHosts.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 ("文件传输成功!") ''大家一起处理
    
    
    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
    
    
    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
    
    
    ProgressBar1.Value = 0
    
    cmdsend.Enabled = True
    
    Label1.Caption = "准备传输>>>"
    
    Case RemoteDenyMSG
    
    MsgBox ("用户终止了传输!")
    
    cmdsend.Enabled = True
    
    Label1.Caption = "准备传输>>>"
    
    Close #filehandle
    
    End Select
    
    Exit Sub End Sub