【IT168 技术文档】

　　这是用VB.NET实现的一个简单的P2P示例.利用了UDP打洞技术.分服务器端跟客户端.服务器端负责登陆记录用户的IP和端口及转发打洞消息.打洞技术依赖于由公共防火墙和CONE NAT，允许适当的有计划的端对端应用程序通过NAT“打洞”，即使当双方的主机都处于NAT之后。需要注意的是,“术”如其名，UDP打洞技术的可靠性全都要依赖于UDP。

　　服务器端在启动成功后，输入help可以查看到服务器相关命令。

　　客户端在登陆成功后.输入help可以查看客户端相关命令。（登陆时用户名随便）

　　以下是服务器端：
   
  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