form1.frm

一个文件发送的例子,对于想学习网络编程是个非常好的学习例子

    
    
    Select Case strGTdata
        
        
    Case "nofile!" '拒绝接收文件
    
    
        XMsgBox "对方拒绝接收该文件!", vbInformation, "返回信息", ChartFrm.Picture3
        state.Caption = "对方拒绝接收该文件!"
        SDFileStart.Enabled = True
        SDFileStart.Caption = "开始发送"
        
        If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
            flash.Enabled = True
        End If
        
    Case "loferror!" '文件大小错误
    
    
        If XMsgBox("继传的目标文件比对方源文件要大,无法继传!是否重新选择保存路径?" & _
        vbCrLf & "点击 <是> 则为重新选择要保存的文件路径,点 <否> 则为拒绝接收该文件", vbQuestion + vbYesNo, "询问", ChartFrm.Picture3) = vbYes Then
        
            Call SelectTGTfile
            '打开选择目标文件对话框
            
        Else
            '向对方发送"拒绝接收"的消息
            Winsock1.SendData str2byt("nofile!", 1)

        End If
        
        If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
            flash.Enabled = True
        End If
        
        
   Case "fileok!" '文件接收完毕
    
   '
        blnGFileing = False
        SDFileStart.Caption = "开始发送"
        SDFileStart.Enabled = True

        
        XMsgBox "因为对方已经完整的接收了此文件,所以不需要再次发送", vbInformation, "信息", ChartFrm.Picture3
        If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
            flash.Enabled = True
        End If
        state.Caption = "无需向对方再次发送此文件"
        
    Case "filestop!" '对方停止发送文件
        
        
        blnGFileing = False
        gtjindu.Enabled = False
        Winsock1.SendData str2byt("stoptn!", 1)
        XMsgBox "对方停止发送!", vbInformation, "信息", ChartFrm.Picture3
        If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
            flash.Enabled = True
        End If
        state.Caption = "对方停止发送!"
        
    End Select
    
    
    
Case 2  '如果收到的信息是聊天消息

        strGTdata = byt2str(GTdata)
        
        ChartFrm.txtshow.Text = strGTdata & vbCrLf & vbCrLf & ChartFrm.txtshow.Text
        
        If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
            flash.Enabled = True
        End If
        

'Case 3  '如果收到的聊天消息收到确认信息


'这个程序以前用的UDP协议.
'不论什么数据发送过去都要求对方返回确认信息的.聊天信息也不例外,需要返回一个聊天消息接收到的确认信息
'但即使要求对方返回消息都无法避免数据丢包
'无奈之下只好更换了TCP协议
'现在就不需要对方返回确认消息了.TCP协议的可靠性很强.协议自身会检测对方是否收到发送的数据.就不需要我这么多此一举了
'留个接口在这用.以后还可以再加其他自定义类型的信息


Case 4  '如果收到的是发送请求消息


    
        strGtFilename = byt2filename(GTdata)
        lngGtFilesize = byt2filesize(GTdata)
        
        If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
            flash.Enabled = True
        End If

        If XMsgBox("对方要求你接收一个名为   " & strGtFilename & vbCrLf & "大小为   " & lngGtFilesize & _
        "   字节的文件,是否接收?", vbQuestion + vbYesNo, "询问", ChartFrm.Picture1) = vbYes Then
    
            Call SelectTGTfile
        
        Else
    
            Winsock1.SendData str2byt("nofile!", 1)
    
        End If

    
Case 5  '文件数据位置请求消息
        
        SDFileStart.Enabled = True
        
        c = byt2gtinfo(GTdata)
        
        Close #1
        
        Open strSdFilePath For Binary As #1
        
        blnSFileing = True
        
        Call ReadFile
        
        filestop = False
        
        If blnRdFileOver = True And Winsock2.state = 7 Then
        
            Winsock2.SendData SDdata
            sdjindu.Enabled = False
            state.Caption = "对方正在接收数据"
        
        End If
        
    
End Select



Exit Sub

err:
Exit Sub



End Sub

'当弹出对方要求接收消息框后点了是则会出现


Sub savefile()

If lngGtFilesize > 1024 Then


    Label12.Caption = "[" & lngGtFilesize \ 1024 & " KB]"
    
Else
    Label12.Caption = "[" & lngGtFilesize & " Byte]"
    
End If
    

If Dir(strGtFilepath) <> "" Then

    If XMsgBox("此文件已经存在,是否继传?" & vbCrLf & "点 <是> 则继传,点 <否> 则覆盖文件重新接收", vbQuestion + vbYesNo, "询问", ChartFrm.Picture1) = vbYes Then
        
        xuchuan = True
    Else
        xuchuan = False
    End If

End If


Close #2

Open strGtFilepath For Binary As #2


   

If xuchuan = True Then
       
    d = LOF(2)
    
    If lngGtFilesize = d Then
    
    Close #2
    Winsock1.SendData str2byt("fileok!", 1)
    XMsgBox "此文件已经接收完毕,不需要对方再次发送", , "信息", ChartFrm.Picture3
    
    If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
        flash.Enabled = True
    End If
    
    Exit Sub
    
   
End If

    
Else
    d = 0
    
End If

Winsock1.SendData gtinfo2byt(d)


End Sub




Private Sub sendclose()

ipaddress.BackColor = &H80000005
ipaddress.Enabled = True
TCPconnect.Caption = "连接"
TCPconnect.Enabled = True
ChartFrm.SendWord.Enabled = False
SDFileStart.Enabled = True
SDFileStart.Caption = "开始发送"
blnSFileing = False
blnGFileing = False
state.Caption = "你与对方的连接被断开!"
Timer1.Enabled = False
Label7.Caption = ""
Label8.Caption = ""
sdjindu.Enabled = False
gtjindu.Enabled = False

XMsgBox "你与对方的连接已被断开!", vbInformation, "提示", ChartFrm.Picture3

If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
    flash.Enabled = True
End If

End Sub


'保选择存文件路径

Sub SelectTGTfile()

Dim gtfilepath As String
gtfilepath = myReadINI(path & "sendfile.ini", "Path", "lastgtfile", App.path)



strGtFilepath = DialogFile(Me.hwnd, 0, "保存文件", strGtFilename, strGtFilename & Chr(0) & "*.*", gtfilepath, "")


If strGtFilepath = "" Then

    If XMsgBox("是否拒绝接收该文件?点 <是> 则为拒绝接收该文件,点 <否> 则为重新选择保存路径", vbYesNo + vbQuestion + vbDefaultButton2, "询问", ChartFrm.Picture1) = vbYes Then
        
         Winsock1.SendData str2byt("nofile!", 1)
         Exit Sub
         
    Else
    
         strGtFilepath = DialogFile(Me.hwnd, 0, "保存文件", strGtFilename, strGtFilename & Chr(0) & "*.*", App.path, "")

    End If
    
End If
    
    

If strGtFilepath <> "" Then

        strGTFolderPath = Left(strGtFilepath, InStrRev(strGtFilepath, strGtFilename) - 1)
        
        Debug.Print strGTFolderPath

'strGTFolderPath是保存文件的所在目录的
'本来可以用getcanusebyte直接对这个目录的所剩空间进行检测
'不过为了怕这样会有什么BUG,还是不用了.只取它的最前一个字符作为盘符检测好了


'恐怕会对保存为网络上的可写空间造成影响.但我不知道getcanusebyte能不能检测网络上的可写空间的磁盘可用空间.我没试过


    If getcanusebyte(Left(strGTFolderPath, 1) & ":") < lngGtFilesize Then

        If XMsgBox("这个磁盘空间不足以存放此文件!" & vbCrLf & "点 <是> 则为重新选择文件保存期路径,点 <否> 则为拒绝接收该文件", vbYesNo + vbQuestion, "询问", ChartFrm.Picture1) = vbYes Then
    
            strGtFilepath = DialogFile(Me.hwnd, 0, "保存文件", strGtFilename, strGtFilename & Chr(0) & "*.*", App.path, "*.*")
            
        Else
    
            Winsock1.SendData str2byt("nofile!", 1)
            Exit Sub
        
        End If

    End If

    Call myWriteINI(path & "sendfile.ini", "Path", "LastGtfile", strGTFolderPath)
    Call savefile
    
Else

    Winsock1.SendData str2byt("nofile!", 1)

End If

End Sub


'用来分析并读取数据发送
Sub ReadFile()

fileover = False
      
    '这里对方发送的目标文件大小与源文件大小作比较
    
    '如果目标文件比源文件小,则:
    
            '如果对方的目标文件大小比源文件要小于1K以上.则可以把从源文件中截取出1K的数据发送
            '如果目标文件大小与源文件大小差距在1K以下.则可以把源文件与目标文件相差的字节截取出来发送
    
    '如果目标文件于源文件相同,则:
    
            '向对方发送"接收完毕"的消息,同时弹出发送完毕的对话框
    
    
    '如果目标文件大小比源文件还要大.则发送"文件大小错误"信息发送过去.使对方不能继传.只能选择覆盖或另存路径
    
    If c < lngSdFilesize Then
    
        If lngSdFilesize - c > 1024 Then  '差距在1K以上
    
            ReDim SDdata(1023) As Byte
                
            k = c + 1024
        
        Else '差距1K以下
        
            ReDim SDdata(lngSdFilesize - c - 1) As Byte
                
            k = c + UBound(SDdata) + 1
            
        End If
            

        Get #1, c + 1, SDdata  '从文件中读取数据
        
        c = k
        
        blnRdFileOver = True
        '这里使用文件数据发送专用的Winsock2来发送文件数据信息
'        Winsock2.SendData SDdata
           
    ElseIf c = lngSdFilesize Then   '目标文件与源文件大小相同
            
        fileover = True
            
    ElseIf c > lngSdFilesize Then  '如果目标文件大于源,则发送"大小错误"消息给对方
    
            Winsock1.SendData str2byt("loferror!", 1)
            
    
    End If
        
        

End Sub

Private Sub Winsock2_Connect()

If Winsock2.state = 7 Then
    ChartFrm.SendWord.Enabled = True
End If

End Sub

Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)

If Winsock2.state <> sckClosed Then Winsock2.Close
'接受具有 requestID 参数的
'连接。
Winsock2.Accept requestID

End Sub


'Winsokc2处理接收到的数据
'为了提高数据处理速度.
'Winsock2专用来发送文件数据,这样的话不必像Winsock1那样对消息类型进行检测处理了.发送过去也不必进行处理.效率会提高

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)

Winsock2.GetData GTdata

blnGFileing = True

Put #2, d + 1, GTdata

d = d + UBound(GTdata) + 1

Label10.Caption = d

gtjindu.Enabled = True

If d = lngGtFilesize Then
    
    
    gtjindu.Enabled = False
    Label8.Caption = "接收完毕!"
    blnGFileing = False
    XpPB2.Value = 0
    XpPB2.Value = 100
    Close #2
    
    If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
        flash.Enabled = True
    End If
    
    If tishi = False Then
    
        XMsgBox "文件接收完毕!", vbInformation, "恭喜", ChartFrm.Picture3
    
    Else
    
        If XMsgBox("文件接收完毕!是否打开文件接收保存目录?", vbInformation + vbYesNo, "恭喜", ChartFrm.Picture1) = vbYes Then
        
            Dim a As String
            
            a = "explorer.exe " & strGTFolderPath
            
            Shell a, vbNormalFocus
        End If
    End If
    
    state.Caption = "文件接收完毕!"
    
End If

End Sub



'文件数据发送完毕后继续发送下一段文件数据

Private Sub Winsock2_SendComplete()

Label9.Caption = c

sdjindu.Enabled = True

If blnRdFileOver = True And Winsock2.state = 7 And filestop = False And fileover = False Then
    
    Winsock2.SendData SDdata
    
    blnRdFileOver = False
    
ElseIf blnSFileing = True And fileover = True Then

 '   Winsock1.SendData str2byt("fileok!", 1)
    
    Label7.Caption = "发送完毕!"
    
    sdjindu.Enabled = False

    SDFileStart.Caption = "开始发送"
    
    blnSFileing = False
            
    Close #1
    
    
    
    
    XpPB1.Value = 0
    XpPB1.Value = 100
    '之所以要先让那个进度条的值为0再为100是因为那个进度条不刷新前面的.老是显示错误.
    '但为了XP风格我又不想放弃那进度条.
    '所以就得这样写了.
    '不然我不加注释大家一定看不懂.唉
    
    
    
    If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
        flash.Enabled = True
    End If
    
    state.Caption = "文件发送完毕!"
    
    
    '之所以把msgbox都放到最后是因为它会打断TIMER控件的运行
    XMsgBox "此文件已经传送完毕!", vbInformation, "任务完成!", ChartFrm.Picture3
    
    
End If

End Sub


'在数据发送途中发送方先把下一段文件数据读取出来并处理好.
'在发送完毕后可以立即发送下一段数据.
'可以提高效率

Private Sub Winsock2_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)

Call ReadFile

End Sub