module1.vb

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

Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading
Imports System.Collections

Module myUDPServer

#Region "全局变量"

    Dim ServerSocket As New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
    Dim ipep As IPEndPoint = New IPEndPoint(IPAddress.Any, 11000)

    Dim htUserList As New Hashtable '用来保存在线用户和用户的"IP和端口" 

    Dim userName(0) As String
    Dim userIPEP(0) As IPEndPoint
    Dim userTime(0) As Integer

    Dim timerDelegate As New TimerCallback(AddressOf onLineTimeOut)

#End Region

#Region "参数"

    '以下是客户端到服务器端的消息开头 
    Const LOGININ As String = "10" '请求登陆的消息|||消息形式:10+自己的用户名 
    Const LOGINOUT As String = "11" '请求登出的消息|||消息形式:11+自己的用户名 
    Const GETULIST As String = "12" '请求获得在线用户列表|||消息形式:12 
    Const P2PCONN As String = "13" '请求P2P连接的消息|||消息形式:13+自己的用户名+|+对方的用户名 
    Const HOLDLINE As String = "14" '保持连接.|||消息开式:14+自己的用户名 

    '以下是服务器到客户端的消息开头 
    Const HVUSER As String = "20" '用户名已存在 
    Const GETUSER As String = "21" '在线用户列表|||消息格式:21+用户名+EP 
    Const MAKHOLD As String = "22" '打洞命令|||消息格式:22+IP 
    Const LOGINOK As String = "23" '登陆成功 
    Const SERVCLS As String = "24" '服务器关闭 
    Const MSGEND As String = "25" '消息结束 

    '以下是服务器端的命名 
    Const EXITPRO As String = "EXIT" '退出命令 
    Const SHOWULIST As String = "SHOWUSER" '显示在线用户 
    Const HELP As String = "HELP" '显示帮助 

#End Region

#Region "方法"

    '主函数,程序入口 
    Sub Main()

        '获得服务器的IP地址 
        Dim addressList As System.Net.IPAddress() = Dns.GetHostByName(Dns.GetHostName()).AddressList
        Dim ServerIP As IPAddress = addressList(0)

        ServerSocket.Bind(ipep)
        Console.WriteLine("服务器正在启动....")
        Console.WriteLine("服务器IP:" & ServerIP.ToString & " 正在监听" & ipep.Port.ToString & "端口")
        Dim listenTH As New Thread(AddressOf listen)
        listenTH.Start() '启用监听的线程 
        Console.WriteLine("服务器启动成功.....")

        Dim timer As New Timer(timerDelegate, Nothing, 0, 5000)

        Dim SVInput As String
        While True
            Console.Write("Server>")
            SVInput = Console.ReadLine().ToUpper
            Select Case SVInput
                Case EXITPRO
                    listenTH.Abort()
                    ServerSocket.Close()
                    Exit Sub
                Case SHOWULIST
                    showUser()
                Case HELP
                    Console.Write("*********************************" & Chr(10) & Chr(13) & "exit:输出当前程序" & Chr(10) & Chr(13) & "showuser:显示当前在线用户例表" & Chr(10) & Chr(13) & "help:显示帮助" & Chr(10) & Chr(13) & "*********************************" & Chr(10) & Chr(13))
                Case Else
                    Console.WriteLine("*********************************" & Chr(10) & Chr(13) & "笨瓜,你输入的不是有效的命令." & Chr(10) & Chr(13) & "*********************************")
            End Select
        End While


    End Sub

    '打印在线用户 
    Sub showUser()
        Dim hava As Boolean = False
        If userName.Length <> 0 Then
            Dim i As Integer
            For i = 1 To userName.Length - 1
                If userName(i) <> "" Then
                    hava = True
                    Exit For
                End If
            Next
            If hava = False Then
                Console.WriteLine("*********************************" & Chr(10) & Chr(13) & "当前没有用户在线" & Chr(10) & Chr(13) & "*********************************")
                Exit Sub
            End If
            Console.WriteLine("*********************************")
            For i = 1 To userName.Length - 1
                If userName(i) <> "" Then
                    Console.WriteLine("用户名:" & userName(i) & " 地址:" & userIPEP(i).ToString)
                End If
            Next
            Console.WriteLine("*********************************")
        Else
            Console.WriteLine("*********************************" & Chr(10) & Chr(13) & "当前没有用户在线" & Chr(10) & Chr(13) & "*********************************")
        End If
    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 = ServerSocket.ReceiveFrom(data, tempRemoteEP)

                'Console.WriteLine(Encoding.Unicode.GetString(data)) 

                Dim msgHead As String = Encoding.Unicode.GetString(data, 0, 4)
                Select Case msgHead
                    Case LOGININ
                        Dim LoginThing As String = userLogin(data, tempRemoteEP, recv)
                        If LoginThing = HVUSER Then
                            sendMsg(HVUSER, tempRemoteEP)
                        ElseIf LoginThing = LOGINOK Then
                            sendMsg(LOGINOK, tempRemoteEP)

                        End If

                    Case LOGINOUT
                        userloginout(data, recv)

                    Case GETULIST
                        Dim userinfo As String = getUserList()
                        sendMsg(userinfo, tempRemoteEP)

                    Case P2PCONN
                        questP2PConn(data, recv)

                    Case HOLDLINE
                        holdOnLine(data, recv)
                End Select

            Catch e As Exception
                'Console.WriteLine(e.ToString) 
            End Try
        End While

    End Sub

    '转发P2P连接请求 
    Private Sub questP2PConn(ByVal data() As Byte, ByVal recv As Integer)

        Dim recvStr As String = Encoding.Unicode.GetString(data, 4, recv - 4)
        Dim split() As String = recvStr.Split("|")

        Dim fromEP As IPEndPoint
        Dim toEP As IPEndPoint
        Dim i As Integer
        For i = 1 To userName.Length - 1
            If userName(i) = split(0) Then
                fromEP = userIPEP(i)
            End If
            If userName(i) = split(1) Then
                toEP = userIPEP(i)
            End If
        Next
        Dim holdbytes() As Byte = Encoding.Unicode.GetBytes(MAKHOLD & fromEP.ToString)
        ServerSocket.SendTo(holdbytes, toEP)
    End Sub

    '函数.返回所有在线用户.其格式:用户名+|+用户IPEP+| 
    Private Function getUserList() As String
        Dim userInfo As String = GETUSER
        Dim i As Integer
        For i = 1 To userName.Length - 1
            If userName(i) <> "" Then
                userInfo += userName(i) & "|" & userIPEP(i).ToString & "|"
            End If
        Next
        Return userInfo
    End Function

    '用户登陆,直接返回登陆是否成功的值 
    Private Function userLogin(ByVal data As Byte(), ByVal userEP As IPEndPoint, ByVal recvCount As Integer) As String

        Dim Uname As String = Encoding.Unicode.GetString(data, 4, recvCount - 4)

        Dim Uinfobytes() As Byte

        Dim i As Integer
        Dim j As Integer

        For i = 1 To userName.Length - 1
            If Uname = userName(i) Then
                Return HVUSER
            End If
        Next

        For i = 1 To userName.Length - 1
            If userName(i) = "" Then
                userName(i) = Uname
                userIPEP(i) = userEP
                userTime(i) = 60
                Console.Write(Chr(10) & Chr(13) & "*********************************" & Chr(10) & Chr(13) & Uname.Trim & "上线了." & "用户地址:" & userEP.ToString & Chr(10) & Chr(13) & "*********************************" & Chr(10) & Chr(13))
                Console.Write("Server>")

                Uinfobytes = Encoding.Unicode.GetBytes(LOGININ & userName(i) & "|" & userIPEP(i).ToString)

                For j = 1 To userName.Length - 1
                    If userName(j) <> "" And userName(j) <> Uname Then
                        ServerSocket.SendTo(Uinfobytes, userIPEP(j))
                    End If
                Next
                Return LOGINOK
            End If
        Next

        Dim userCount As Integer = userName.Length

        ReDim Preserve userName(userCount)
        ReDim Preserve userIPEP(userCount)
        ReDim Preserve userTime(userCount)

        userName(userName.Length - 1) = Uname
        userIPEP(userIPEP.Length - 1) = userEP
        userTime(userTime.Length - 1) = 60

        Console.Write(Chr(10) & Chr(13) & "*********************************" & Chr(10) & Chr(13) & Uname.Trim & "上线了." & "用户地址:" & userEP.ToString & Chr(10) & Chr(13) & "*********************************" & Chr(10) & Chr(13))
        Console.Write("Server>")

        Uinfobytes = Encoding.Unicode.GetBytes(LOGININ & userName(userName.Length - 1) & "|" & userIPEP(userName.Length - 1).ToString)

        For j = 1 To userName.Length - 1
            If userName(j) <> "" And userName(j) <> Uname Then
                ServerSocket.SendTo(Uinfobytes, userIPEP(j))
            End If
        Next
        Return LOGINOK

    End Function

    '用户登出 
    Private Sub userloginout(ByVal data As Byte(), ByVal recvCount As Integer)

        Dim i As Integer
        Dim Uname As String = Encoding.Unicode.GetString(data, 4, recvCount - 4)

        For i = 1 To userName.Length - 1

            If Uname = userName(i) Then

                Dim loginOutMsg As String = LOGINOUT & userName(i)


                userName(i) = ""
                userIPEP(i) = Nothing
                userTime(i) = 0

                Dim j As Integer
                For j = 1 To userName.Length - 1
                    If userName(j) <> "" Then

                        sendMsg(loginOutMsg, userIPEP(j))

                    End If
                Next

                Console.WriteLine(Chr(10) & Chr(13) & "*********************************")
                Console.WriteLine("用户" & Uname & "下线了.")
                Console.WriteLine("*********************************")
                Console.Write("Server>")

                Exit For

            End If

        Next

    End Sub

    '保持用户在线的过程 
    Private Sub holdOnLine(ByVal data As Byte(), ByVal recvCount As Integer)

        Dim Uname As String = Encoding.Unicode.GetString(data, 4, recvCount - 4)

        Dim i As Integer

        For i = 1 To userName.Length - 1

            If Uname = userName(i) Then

                userTime(i) = 60
                Exit For

            End If

        Next

    End Sub

    '用户超时退出 
    Private Sub onLineTimeOut(ByVal state As [Object])

        Dim i As Integer

        For i = 1 To userName.Length - 1

            If userTime(i) > 0 Then

                userTime(i) -= 5

                If userTime(i) <= 0 Then

                    Dim loginoutmsg As String = LOGINOUT & userName(i)

                    Console.WriteLine(Chr(10) & Chr(13) & "*********************************")
                    Console.WriteLine("用户" & userName(i) & "下线了.")
                    Console.WriteLine("*********************************")
                    Console.Write("Server>")

                    userName(i) = ""
                    userIPEP(i) = Nothing

                    Dim ULoginOutbytes() As Byte = Encoding.Unicode.GetBytes(loginoutmsg)

                    Dim j As Integer
                    For j = 1 To userName.Length - 1

                        If userName(j) <> "" Then
                            If userIPEP(j) Is Nothing Then
                            Else
                                ServerSocket.SendTo(ULoginOutbytes, userIPEP(j))
                            End If
                        End If

                    Next

                End If

            End If

        Next

    End Sub

    '发送消息的函数 
    Sub sendMsg(ByVal msg As String, ByVal remoteEP As IPEndPoint)
        Dim sendBytes As [Byte]() = Encoding.Unicode.GetBytes(msg)
        Try

            ServerSocket.SendTo(sendBytes, remoteEP)

        Catch e As Exception
            Console.WriteLine(e.ToString())
        End Try
    End Sub

#End Region

End Module