form1.frm

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

Private Sub OPtion_Click()
setfrm.Show
End Sub

Private Sub proxy_Click()
proxySet.Show
End Sub

Private Sub SDFilebrowse_Click()


'打开文件对话框,选择要发送的文件

Dim sdfile As String
sdfile = myReadINI(path & "sendfile.ini", "path", "lastsdfile", App.path)


strSdFilePath = DialogFile(Me.hwnd, 1, "选择要发送的文件", "*.*", "All files" & Chr(0) & "*.*", sdfile, "*.*")

If strSdFilePath <> "" Then
    sdfilepath.Text = strSdFilePath
    strSdFilename = Dir(strSdFilePath)
    lngSdFilesize = FileLen(strSdFilePath)
    Label2.Caption = "文件大小: " & lngSdFilesize & " Byte"
    Label2.ToolTipText = lngSdFilesize & " Byte"
    Label3.Caption = "文件名称: " & strSdFilename
    Label3.ToolTipText = strSdFilename
End If

Call myWriteINI(path & "sendfile.ini", "Path", "LastSDfile", strSdFilePath)


End Sub

Private Sub chart_Click()

'显示或关闭聊天窗口

If Chart.Caption = ">" Then

    ChartFrm.Top = MainFrm.Top
    ChartFrm.Left = MainFrm.Left + MainFrm.Width
    ChartFrm.Height = MainFrm.Height
    ChartFrm.Show
    Chart.Caption = "<"
    ChartFrm.Timer1.Enabled = True
    
Else
    Unload ChartFrm
    Chart.Caption = ">"
End If


End Sub





Private Sub SDFileStart_Click()

'c为发送的数据处于文件的位置
'初始化它
c = 0

'当发现winsock的状态不为连接时退出过程

If Winsock1.state <> 7 Or Winsock2.state <> 7 Then
    Exit Sub
End If


Select Case SDFileStart.Caption

Case "开始发送"

'如果按钮的标题为"开始发送"则判断文件路径名是否有效,
'如果有效的话则向对方的winsock1发送文件名\文件大小这两个信息

    If Dir(sdfilepath.Text) <> "" And sdfilepath.Text <> "" Then

        Winsock1.SendData fileinfo2byt(lngSdFilesize, strSdFilename)
        
        If lngSdFilesize > 1024 Then
        
        
            Label11.Caption = "[" & lngSdFilesize \ 1024 & " KB]"
            
        Else
        
            Label11.Caption = "[" & lngSdFilesize & " Byte]"
            
        End If
            
        SDFileStart.Enabled = False
        SDFileStart.Caption = "停止发送"
        state.Caption = "正在等待对方接收"

    Else


'如果路径无效则退出过程

        XMsgBox "要发送的文件路径无效!", vbInformation, , ChartFrm.Picture1
        Exit Sub
        
    End If

    
    
Case "停止发送"

    If XMsgBox("对方正在接收文件,你确定要停止发送文件吗?", vbQuestion + vbYesNo + vbDefaultButton2, "询问是否停止", ChartFrm.Picture1) = vbYes Then
        '向对方发送"停止文件发送"的信息
        
        filestop = True
        blnSFileing = False
        Winsock1.SendData str2byt("filestop!", 1)
    
        SDFileStart.Caption = "开始发送"
    End If
    
End Select

End Sub





Private Sub sdjindu_Timer()


Dim e As Long

b = c - b

e = Int(c / (lngSdFilesize / 100))

Label7.Caption = b \ 1024 & " KB/S " & e & "%"

XpPB1.Value = 0
XpPB1.Value = e

b = c

End Sub




'本来不该用按钮的标题进行判断.应该用设置变量进行判断的.
'此处代码应该改写.

Private Sub TCPconnect_Click()

'与对方电脑建立TCP连接

On Error GoTo err:


Select Case TCPconnect.Caption


Case "连接"

'初始化两个winsock
    Winsock1.Close
    Winsock2.Close

    If ipaddress.Text <> "" Then
        
        '如果地址栏不为空则设定两个sock的远程端口和IP作客户端再进行连接

        
        If getip(ipaddress.Text) <> "" Then
        
            ipaddress.Text = getip(ipaddress.Text)
        
            Winsock1.RemoteHost = ipaddress
            Winsock2.RemoteHost = ipaddress
            Winsock1.RemotePort = port
            Winsock2.RemotePort = port2
            Winsock1.Connect
            Winsock2.Connect
        
        
            TCPconnect.Enabled = False
            ipaddress.Enabled = False
            ipaddress.BackColor = &H8000000B
            state.Caption = "正在向对方发送连接请求.等待对方响应"
            Timer1.Enabled = True
        
            TCPconnect.ToolTipText = "断开与对方的连接.如果正在发送或接收文件,这将会使得发送或接收中的文件中断!"
        
        Else
        
            XMsgBox "域名或主机名无法被解析!", vbInformation, "解析出错", ChartFrm.Picture2
            
        End If
        

    Else
        
        '如果地址栏为空则监听本机端口建立TCP服务器端
        
        ipaddress.Enabled = False
        ipaddress.BackColor = &H8000000B
        
        Winsock1.LocalPort = port
        Winsock2.LocalPort = port2
        Winsock1.Listen
        Winsock2.Listen
    
        TCPconnect.Caption = "取消等待"
        
        state.Caption = "端口监听中.正在等待对方连接"
        
        TCPconnect.ToolTipText = "取消对端口的监听,不等待对方的连接"

        
    End If

    
Case "取消等待"
    
    



'关闭winsock取消等待
    Winsock1.Close
    Winsock2.Close
            
    state.Caption = "关闭端口,取消等待状态"
            
    TCPconnect.Caption = "连接"
            
    ipaddress.Enabled = True
    ipaddress.BackColor = &H80000005
    
    TCPconnect.ToolTipText = "与对方建立连接,如果IP栏为空的话,则监听端口等待对方连接"
    
    
Case "断开连接"
    
    If blnSFileing = True Or blnGFileing = True Then

        If XMsgBox("你正在和对方互传文件,你确定要断开连接吗?这将中止与对方的文件互传", vbQuestion + vbYesNo + vbDefaultButton2, "询问", ChartFrm.Picture1) = vbYes Then
            
            
            Winsock1.Close
            Winsock2.Close
            Call sendclose
            
            TCPconnect.ToolTipText = "与对方建立连接,如果IP栏为空的话,则监听端口等待对方连接"
        
        End If
        
    Else
        
        Winsock1.Close
        Winsock2.Close
        Call sendclose
            
        TCPconnect.ToolTipText = "与对方建立连接,如果IP栏为空的话,则监听端口等待对方连接"
        
        
    End If
    
End Select

Exit Sub

err:


'我不清楚下面每一个错误都具体代表着什么意思.
'但我想给用户一些发生错误的提示总比隐瞒错误来得好些.就把MSDN上的出错提示全弄过来了.


Select Case err.Number

Case 7: XMsgBox "内存不足!", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 380: XMsgBox "属性值无效", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 394: XMsgBox "属性不可读", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 383: XMsgBox "属性是只读的", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 40006: XMsgBox "所请求的事务或请求本身的错误协议或者错误连接状态", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 40014: XMsgBox "传递给函数的参数格式不确定，或者不在指定范围内", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 40018: XMsgBox "不受支持的变量类型", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 40020: XMsgBox "在当前状态下的无效操作", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 40021: XMsgBox "参数越界", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 40026: XMsgBox "所请求的事务或请求本身的错误协议", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 1004: XMsgBox "取消操作", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10014: XMsgBox "所请求的地址是广播地址，但未设置标记", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10035: XMsgBox "套接字不成块，而指定操作将使之成块", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10036: XMsgBox "制造块的 Winsock 操作在进行之中", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10037: XMsgBox "完成操作。未进行制造块的操作", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10038: XMsgBox "描述符不是套接字", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10040: XMsgBox "数据报太大，不适于缓冲区的要求，因而被截断", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10043: XMsgBox "不支持指定的端口", vbCritical, "错误号" & err.Number, ChartFrm.Picture2

'这个错误的提示比较常见,提示已经被修改过而非MSDN里的帮助
Case 10048: XMsgBox "端口已被其他应用程序占用,请重新指定端口号", vbCritical, "错误号" & err.Number, ChartFrm.Picture2

Case 10049: XMsgBox "来自本地机器的不可用地址", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10050: XMsgBox "网络子系统失败", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10051: XMsgBox "此时不能从主机到达网络", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10052: XMsgBox "在设置 SO_KEEPALIVE 时连接超时", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 11053: XMsgBox "由于超时或者其它失败而中止连接", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10054: XMsgBox "通过远端重新设置连接", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10055: XMsgBox "没有可用的缓冲空间", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10056: XMsgBox "已连接套接字", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10057: XMsgBox "未连接套接字", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10058: XMsgBox "已关闭套接字", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10060: XMsgBox "已关闭套接字", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10061: XMsgBox "强行拒绝连接", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 10093: XMsgBox "应首先调用 WinsockInit", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 11001: XMsgBox "授权应答：未找到主机", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 11002: XMsgBox "非授权应答：未找到主机", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 11003: XMsgBox "不可恢复的错误", vbCritical, "错误号" & err.Number, ChartFrm.Picture2
Case 11004: XMsgBox "无效名，对所请求的类型无数据记录", vbCritical, "错误号" & err.Number, ChartFrm.Picture2

End Select



state.Caption = ""

Winsock1.Close
Winsock2.Close
Call sendclose

Exit Sub



End Sub





Private Sub Form_Load()

state.Caption = "IP栏为空直接点击连接为建立主机,输入对方IP点击连接为连接主机"

End Sub

Private Sub Form_Unload(cancel As Integer)

'判断是否正和对方互传文件中,如果是的话弹出对话框提醒对方
If blnSFileing = True Or blnGFileing Then

    If XMsgBox("你正与对方互传文件中,是否退出程序?", vbQuestion + vbYesNo + vbDefaultButton2, "询问", ChartFrm.Picture1) = vbYes Then
    
        Winsock1.Close
        Winsock2.Close
        Call myWriteINI(path & "sendfile.ini", "Face", "FormTop", Me.Top)
        Call myWriteINI(path & "sendfile.ini", "Face", "FormLeft", Me.Left)
        
        End
    
    Else

        cancel = 1
    
    End If
    
Else
    
    Winsock1.Close
    Winsock2.Close

    End
    
End If
    
End Sub


'这是当输入了IP地址点击了连接后开始启动这个Timer的.
'判断5秒钟后Winsock的状态.如果不为7时就认为连接超时失败

Private Sub Timer1_Timer()

If Winsock1.state <> 7 Or Winsock2.state <> 7 Then

    Winsock1.Close
    Winsock2.Close
    
    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 = "连接失败!请确保IP地址有效并且对方开启此应用程序并对端口进行监听"
    Label7.Caption = ""
    Label8.Caption = ""
    
    If GetForegroundWindow <> ChartFrm.hwnd And GetForegroundWindow <> ChartFrm.hwnd Then
        flash.Enabled = True
    End If
    
    sdjindu.Enabled = False
    gtjindu.Enabled = False
    
    Timer1.Enabled = False
    
End If
    
End Sub





'用来当不停的闪烁标题栏的.
Private Sub Flash_Timer()

FlashWindow MainFrm.hwnd, 1
    
If GetForegroundWindow = Me.hwnd Or GetForegroundWindow = ChartFrm.hwnd Then flash.Enabled = False

    
End Sub

Private Sub Winsock1_Close()
Winsock2.Close
Call sendclose



'下面这个Exit Sub一定要加!
'否则程序会不停的循环运行这个事件中的代码!切记!
'这是Winsock的问题.不是我的程序问题
Exit Sub

End Sub


'在连接成功事件中检测窗体是否具有焦点.否则闪烁标题栏提醒用户注意
Private Sub Winsock1_Connect()

state.Caption = "与对方连接成功!"

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


TCPconnect.Enabled = True
TCPconnect.Caption = "断开连接"

ChartFrm.SendWord.Enabled = True

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

End Sub


'这是Winsock的接受客户机连接时发生的事件

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)

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

state.Caption = "一台IP为 " & Winsock1.RemoteHostIP & " 的计算机与你连接成功"

ipaddress.Text = Winsock1.RemoteHostIP
TCPconnect.Caption = "断开连接"
TCPconnect.Enabled = True

ChartFrm.SendWord.Enabled = True

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

End Sub

'这是Winsock1处理接收到的数据

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

On Error GoTo err:

'这里接收到的数据进行分类


Winsock1.GetData GTdata


Select Case GTdata(0)


Case 1  '如果接收到的是应用程序的信息
    
    
    strGTdata = byt2str(GTdata)