module1.vb

P2P 之 UDP穿透NAT的原理与实现（附源代码） 原创：shootingstars 参考：http://midcom-p2p.sourceforge.net/draft-ford-midcom

        Dim splitStr() As String = Nothing

        splitStr = Ustr.Split("|")

        Dim IPEPSplit() As String = Nothing

        Dim i As Integer = 0

        Dim k As Integer
        For k = 0 To splitStr.Length - 2 Step 2
            ReDim Preserve OLUserName(i)
            ReDim Preserve OLUserEP(i)

            OLUserName(i) = splitStr(k)
            IPEPSplit = splitStr(k + 1).Split(":")
            OLUserEP(i) = New IPEndPoint(IPAddress.Parse(IPEPSplit(0)), IPEPSplit(1))

            IPEPSplit = Nothing
            i += 1
        Next

    End Sub

    '显示在线用户 
    Private Sub showUserList()
        Dim i As Integer
        For i = 0 To OLUserName.Length - 1
            If OLUserName(i) <> "" Then
                Console.WriteLine("用户名:" & OLUserName(i) & " 用户IP:" & OLUserEP(i).ToString)
            End If
        Next
    End Sub

    '客户程序监听的函数 
    Sub listen()

        While True

            Try
                Dim recv As Integer = 0 '收到的字节数 
                Dim data As [Byte]() = New Byte(1024) {} '缓冲区大小 
                Dim sender As New IPEndPoint(IPAddress.Any, 0)
                Dim tempRemoteEP As EndPoint = CType(sender, EndPoint)
                recv = ClientSocket.ReceiveFrom(data, tempRemoteEP)

                Dim msgHead As String = Encoding.Unicode.GetString(data, 0, 4) '获得消息头的内容 
                Select Case msgHead
                    Case MSGEND
                        msgSendEnd = True
                        sendDone.Set()
                    Case LOGININ
                        addOnLine(data, recv)
                    Case LOGINOUT
                        removeOnLine(data, recv)
                    Case MSGEND
                        msgSendEnd = True
                        sendDone.Set()
                    Case MAKHOLD
                        Console.WriteLine(Chr(10) & Chr(13) & "收到打洞消息.")
                        makeHold(data, recv)
                        Console.Write("Client>")
                    Case CHATMSG
                        showChatMsg(data, recv)
                    Case HOLDOK
                        testHold = True
                        holdDone.Set()
                    Case CHTMSGEND
                        testChat = True
                        chatDone.Set()
                End Select

            Catch
            End Try

        End While
    End Sub

    '发送聊天消息 
    Private Sub sendChatMsg(ByVal remoteUser As String, ByVal chatMsgStr As String)

        If remoteUser = username Then
            Console.WriteLine("猪头,你想干什么!!!")
            Exit Sub
        End If

        Dim i As Integer

        Dim remoteUEP As IPEndPoint
        For i = 0 To OLUserName.Length - 1
            If remoteUser = OLUserName(i) Then
                remoteUEP = OLUserEP(i)
                Exit For
            End If
            If i = OLUserName.Length - 1 Then
                Console.WriteLine("找不到你想发送的用户.")
                Exit Sub
            End If
        Next

        Dim msgbytes() As Byte = Encoding.Unicode.GetBytes(CHATMSG & username & "|" & chatMsgStr)
        Dim holdbytes() As Byte = Encoding.Unicode.GetBytes(P2PCONN & username & "|" & remoteUser)

        chatDone = New ManualResetEvent(False)
        ClientSocket.SendTo(msgbytes, remoteUEP)
        chatDone.WaitOne(10000, True)
        If testChat = True Then
            testChat = False
            Exit Sub
        End If

        testHold = False
        While testHold <> True
            Console.WriteLine("打洞ing.....")
            holdDone = New ManualResetEvent(False)
            ClientSocket.SendTo(holdbytes, remoteUEP)
            ClientSocket.SendTo(holdbytes, ServerEP)
            holdDone.WaitOne(10000, True)
            If testHold = True Then
                Exit While
            Else
                Console.WriteLine("打洞超时,发送消息失败.")
                Console.Write("是否重试,按Y重试,按任意值结束发送:")
                Dim YorN As String = Console.ReadLine().ToUpper
                If YorN = "Y" Then
                    testHold = False
                Else
                    Exit Sub
                End If
            End If
        End While

        While testChat <> True
            Console.WriteLine("打洞成功,正在准备发送.....")
            chatDone = New ManualResetEvent(False)
            ClientSocket.SendTo(msgbytes, remoteUEP)
            chatDone.WaitOne(10000, True)
            If testChat = True Then
                Console.WriteLine("消息发送成功!!")
                Exit While
            Else
                Console.WriteLine("发送超时,发送消息失败.")
                Console.Write("是否重试,按Y重试,按任意值结束发送:")
                Dim YorN As String = Console.ReadLine().ToUpper
                If YorN = "Y" Then
                    testChat = False
                Else
                    Exit Sub
                End If
            End If
        End While
        testHold = False
        testChat = False
    End Sub

    '处理聊天消息 
    Private Sub showChatMsg(ByVal indata() As Byte, ByVal recvcount As Integer)
        Dim msgStr As String = Encoding.Unicode.GetString(indata, 4, recvcount - 4)
        Dim splitStr() As String = msgStr.Split("|")
        Dim fromUname As String = splitStr(0)
        Dim msg As String = splitStr(1)
        Console.WriteLine(Chr(10) & Chr(13) & "收到来自" & fromUname & "的消息:" & msg)
        Console.Write("Client>")
        Dim i As Integer
        For i = 0 To OLUserName.Length - 1
            If OLUserName(i) = fromUname Then
                Exit For
            End If
        Next
        Dim tempbytes() As Byte = Encoding.Unicode.GetBytes(CHTMSGEND)
        ClientSocket.SendTo(tempbytes, OLUserEP(i))
    End Sub

    '处理打洞函数 
    Private Sub makeHold(ByVal indata() As Byte, ByVal recvcount As Integer)
        Dim makholdstr As String = Encoding.Unicode.GetString(indata, 4, recvcount)
        Dim ipepstr() As String = makholdstr.Split(":")
        Dim holdEP As IPEndPoint = New IPEndPoint(IPAddress.Parse(ipepstr(0)), ipepstr(1))

        Dim holdbytes() As Byte = Encoding.Unicode.GetBytes(HOLDOK & username)
        ClientSocket.SendTo(holdbytes, holdEP)
        Console.WriteLine("回送打洞消息.")
    End Sub

    '处理用户上线的函数 
    Private Sub addOnLine(ByVal inData() As Byte, ByVal recvCount As Integer)
        Dim inStr As String = Encoding.Unicode.GetString(inData, 4, recvCount - 4)
        Dim userinfo() As String = inStr.Split("|")
        Dim strUserEP() As String = userinfo(1).Split(":")

        Dim i As Integer
        For i = 0 To OLUserName.Length - 1
            If OLUserName(i) = "" Then
                OLUserName(i) = userinfo(0)
                OLUserEP(i) = New IPEndPoint(IPAddress.Parse(strUserEP(0)), strUserEP(1))
                Console.WriteLine(Chr(10) & Chr(13) & "用户" & OLUserName(i) & "上线了. 用户地址:" & OLUserEP(i).ToString)
                Console.Write("Client>")
                Exit Sub
            End If
        Next

        ReDim Preserve OLUserName(i + 1)
        ReDim Preserve OLUserEP(i + 1)

        OLUserName(i + 1) = userinfo(0)
        OLUserEP(i + 1) = New IPEndPoint(IPAddress.Parse(strUserEP(0)), strUserEP(1))

        Console.WriteLine(Chr(10) & Chr(13) & "用户" & OLUserName(i + 1) & "上线了. 用户地址:" & OLUserEP(i + 1).ToString)
        Console.Write("Client>")

    End Sub

    '处理用户下线的函数 
    Private Sub removeOnLine(ByVal inData() As Byte, ByVal recvCount As Integer)
        Dim offUname As String = Encoding.Unicode.GetString(inData, 4, recvCount - 4)

        Dim i As Integer
        For i = 0 To OLUserName.Length - 1
            If OLUserName(i) = offUname Then
                OLUserName(i) = ""
                OLUserEP(i) = Nothing
                Console.WriteLine(Chr(10) & Chr(13) & "用户" & offUname & "下线了.")
                Console.Write("Client>")
                Exit Sub
            End If
        Next
    End Sub

    '发送消息的函数 
    Public Function sendmsg(ByVal msg As String, ByVal sendToIPEP As IPEndPoint) As String

        Dim sendBytes As [Byte]() = Encoding.Unicode.GetBytes(msg)

        '判断发送的字节数是否超过了服务器缓冲区大小 
        If sendBytes.Length > 1024 Then
            Return "W输入的字数太多"
        End If

        '判断消息是否发送成功 
        While msgSendEnd = False

            sendDone = New ManualResetEvent(False)

            Try

                ClientSocket.SendTo(sendBytes, sendToIPEP)

                sendDone.WaitOne(10000, True) '阻塞线程10秒 

                If msgSendEnd = False Then
                    Console.WriteLine("消息发送超时")
                Else
                    Exit While
                End If

            Catch e As Exception

                Console.WriteLine("发送消息失败" & e.ToString)
                Exit Function

            End Try

            Console.Write("是否重试?按Y重试,按任意键退出:")
            Dim userInput As String = Console.ReadLine.ToUpper

            If userInput = "Y" Then
            Else
                msgSendEnd = False
                Exit Function
            End If

        End While

        msgSendEnd = False

    End Function

    '用保持在线状态的函数 
    Private Sub holdonline(ByVal state As [Object])
        ClientSocket.SendTo(holdBytes, ServerEP)
    End Sub

#End Region

End Module