P2P的簡單示例:VB.net版

這是用實現的一個簡單的PP示例利用了UDP打洞技術分服務器端跟客戶端服務器端負責登陸記錄用戶的IP和端口及轉發打洞消息(相關技術在CSDN搜一下有很多的)原理到處都有這裡就沒有貼出來這裡貼出了的代碼供初學者交流也歡迎高手點評 
   
　　服務器端在啟動成功後輸入help可以查看到服務器相關命令 
   
　　客戶端在登陸成功後輸入help可以查看客戶端相關命令(登陸時用戶名隨便) 
   
　　以下是服務器端:
  
  Imports SystemNet
  Imports SystemNetSockets
  Imports SystemText
  Imports SystemThreading
  Imports SystemCollections
  
  Module myUDPServer
  
  #Region 全局變量
  
   Dim ServerSocket As New Socket(AddressFamilyInterNetwork SocketTypeDgram ProtocolTypeUdp)
   Dim ipep As IPEndPoint = New IPEndPoint(IPAddressAny )
  
   Dim htUserList As New Hashtable 用來保存在線用戶和用戶的IP和端口
  
   Dim userName() As String
   Dim userIPEP() As IPEndPoint
   Dim userTime() As Integer
  
   Dim timerDelegate As New TimerCallback(AddressOf onLineTimeOut)
  
  #End Region
  
  #Region 參數
  
   以下是客戶端到服務器端的消息開頭
   Const LOGININ As String = 請求登陸的消息|||消息形式:+自己的用戶名
   Const LOGINOUT As String = 請求登出的消息|||消息形式:+自己的用戶名
   Const GETULIST As String = 請求獲得在線用戶列表|||消息形式:
   Const PPCONN As String = 請求PP連接的消息|||消息形式:+自己的用戶名+|+對方的用戶名
   Const HOLDLINE As String = 保持連接|||消息開式:+自己的用戶名
  
   以下是服務器到客戶端的消息開頭
   Const HVUSER As String = 用戶名已存在
   Const GETUSER As String = 在線用戶列表|||消息格式:+用戶名+EP
   Const MAKHOLD As String = 打洞命令|||消息格式:+IP
   Const LOGINOK As String = 登陸成功
   Const SERVCLS As String = 服務器關閉
   Const MSGEND As String = 消息結束
  
   以下是服務器端的命名
   Const EXITPRO As String = EXIT 退出命令
   Const SHOWULIST As String = SHOWUSER 顯示在線用戶
   Const HELP As String = HELP 顯示幫助
  
  #End Region
  
  #Region 方法
  
   主函數程序入口
   Sub Main()
  
   獲得服務器的IP地址
   Dim addressList As SystemNetIPAddress() = DnsGetHostByName(DnsGetHostName())AddressList
   Dim ServerIP As IPAddress = addressList()
  
   ServerSocketBind(ipep)
   ConsoleWriteLine(服務器正在啟動)
   ConsoleWriteLine(服務器IP: & ServerIPToString & 正在監聽 & ipepPortToString & 端口)
   Dim listenTH As New Thread(AddressOf listen)
   listenTHStart() 啟用監聽的線程
   ConsoleWriteLine(服務器啟動成功)
  
   Dim timer As New Timer(timerDelegate Nothing )
  
   Dim SVInput As String
   While True
   ConsoleWrite(Server>)
   SVInput = ConsoleReadLine()ToUpper
   Select Case SVInput
   Case EXITPRO
   listenTHAbort()
   ServerSocketClose()
   Exit Sub
   Case SHOWULIST
   showUser()
   Case HELP
   ConsoleWrite(********************************* & Chr() & Chr() & exit:輸出當前程序 & Chr() & Chr() & showuser:顯示當前在線用戶例表 & Chr() & Chr() & help:顯示幫助 & Chr() & Chr() & ********************************* & Chr() & Chr())
   Case Else
   ConsoleWriteLine(********************************* & Chr() & Chr() & 笨瓜你輸入的不是有效的命令 & Chr() & Chr() & *********************************)
   End Select
   End While
  
  
   End Sub
  
   打印在線用戶
   Sub showUser()
   Dim hava As Boolean = False
   If userNameLength <> Then
   Dim i As Integer
   For i = To userNameLength
   If userName(i) <> Then
   hava = True
   Exit For
   End If
   Next
   If hava = False Then
   ConsoleWriteLine(********************************* & Chr() & Chr() & 當前沒有用戶在線 & Chr() & Chr() & *********************************)
   Exit Sub
   End If
   ConsoleWriteLine(*********************************)
   For i = To userNameLength
   If userName(i) <> Then
   ConsoleWriteLine(用戶名: & userName(i) & 地址: & userIPEP(i)ToString)
   End If
   Next
   ConsoleWriteLine(*********************************)
   Else
   ConsoleWriteLine(********************************* & Chr() & Chr() & 當前沒有用戶在線 & Chr() & Chr() & *********************************)
   End If
   End Sub
  
   服務器監聽函數
   Sub listen()
  
   While True
  
   Try
   Dim recv As Integer =
   Dim data As [Byte]() = New Byte() {}
   Dim sender As New IPEndPoint(IPAddressAny )
   Dim tempRemoteEP As EndPoint = CType(sender EndPoint)
   recv = ServerSocketReceiveFrom(data tempRemoteEP)
  
   ConsoleWriteLine(EncodingUnicodeGetString(data))
  
   Dim msgHead As String = EncodingUnicodeGetString(data )
   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 PPCONN
   questPPConn(data recv)
  
   Case HOLDLINE
   holdOnLine(data recv)
   End Select
  
   Catch e As Exception
   ConsoleWriteLine(eToString)
   End Try
   End While
  
   End Sub
  
   轉發PP連接請求
   Private Sub questPPConn(ByVal data() As Byte ByVal recv As Integer)
  
   Dim recvStr As String = EncodingUnicodeGetString(data recv )
   Dim split() As String = recvStrSplit(|)
  
   Dim fromEP As IPEndPoint
   Dim toEP As IPEndPoint
   Dim i As Integer
   For i = To userNameLength
   If userName(i) = split() Then
   fromEP = userIPEP(i)
   End If
   If userName(i) = split() Then
   toEP = userIPEP(i)
   End If
   Next
   Dim holdbytes() As Byte = EncodingUnicodeGetBytes(MAKHOLD & fromEPToString)
   ServerSocketSendTo(holdbytes toEP)
   End Sub
  
   函數返回所有在線用戶其格式:用戶名+|+用戶IPEP+|
   Private Function getUserList() As String
   Dim userInfo As String = GETUSER
   Dim i As Integer
   For i = To userNameLength
   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 = EncodingUnicodeGetString(data recvCount )
  
   Dim Uinfobytes() As Byte
  
   Dim i As Integer
   Dim j As Integer
  
   For i = To userNameLength
   If Uname = userName(i) Then
   Return HVUSER
   End If
   Next
  
   For i = To userNameLength
   If userName(i) = Then
   userName(i) = Uname
   userIPEP(i) = userEP
   userTime(i) =
   ConsoleWrite(Chr() & Chr() & ********************************* & Chr() & Chr() & UnameTrim & 上線了 & 用戶地址: & userEPToString & Chr() & Chr() & ********************************* & Chr() & Chr())
   ConsoleWrite(Server>)
  
   Uinfobytes = EncodingUnicodeGetBytes(LOGININ & userName(i) & | & userIPEP(i)ToString)
  
   For j = To userNameLength
   If userName(j) <> And userName(j) <> Uname Then
   ServerSocketSendTo(Uinfobytes userIPEP(j))
   End If
   Next
   Return LOGINOK
   End If
   Next
  
   Dim userCount As Integer = userNameLength
  
   ReDim Preserve userName(userCount)
   ReDim Preserve userIPEP(userCount)
   ReDim Preserve userTime(userCount)
  
   userName(userNameLength ) = Uname
   userIPEP(userIPEPLength ) = userEP
   userTime(userTimeLength ) =
  
   ConsoleWrite(Chr() & Chr() & ********************************* & Chr() & Chr() & UnameTrim & 上線了 & 用戶地址: & userEPToString & Chr() & Chr() & ********************************* & Chr() & Chr())
   ConsoleWrite(Server>)
  
   Uinfobytes = EncodingUnicodeGetBytes(LOGININ & userName(userNameLength ) & | & userIPEP(userNameLength )ToString)
  
   For j = To userNameLength
   If userName(j) <> And userName(j) <> Uname Then
   ServerSocketSendTo(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 = EncodingUnicodeGetString(data recvCount )
  
   For i = To userNameLength
  
   If Uname = userName(i) Then
  
   Dim loginOutMsg As String = LOGINOUT & userName(i)
  
  
   userName(i) =
   userIPEP(i) = Nothing
   userTime(i) =
  
   Dim j As Integer
   For j = To userNameLength
   If userName(j) <> Then
  
   sendMsg(loginOutMsg userIPEP(j))
  
   End If
   Next
  
   ConsoleWriteLine(Chr() & Chr() & *********************************)
   ConsoleWriteLine(用戶 & Uname & 下線了)
   ConsoleWriteLine(*********************************)
   ConsoleWrite(Server>)
  
   Exit For
  
   End If
  
   Next
  
   End Sub
  
   保持用戶在線的過程
   Private Sub holdOnLine(ByVal data As Byte() ByVal recvCount As Integer)
  
   Dim Uname As String = EncodingUnicodeGetString(data recvCount )
  
   Dim i As Integer
  
   For i = To userNameLength
  
   If Uname = userName(i) Then
  
   userTime(i) =
   Exit For
  
   End If
  
   Next
  
   End Sub
  
   用戶超時退出
   Private Sub onLineTimeOut(ByVal state As [Object])
  
   Dim i As Integer
  
   For i = To userNameLength
  
   If userTime(i) > Then
  
   userTime(i) =
  
   If userTime(i) <= Then
  
   Dim loginoutmsg As String = LOGINOUT & userName(i)
  
   ConsoleWriteLine(Chr() & Chr() & *********************************)
   ConsoleWriteLine(用戶 & userName(i) & 下線了)
   ConsoleWriteLine(*********************************)
   ConsoleWrite(Server>)
  
   userName(i) =
   userIPEP(i) = Nothing
  
   Dim ULoginOutbytes() As Byte = EncodingUnicodeGetBytes(loginoutmsg)
  
   Dim j As Integer
   For j = To userNameLength
  
   If userName(j) <> Then
   If userIPEP(j) Is Nothing Then
   Else
   ServerSocketSendTo(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]() = EncodingUnicodeGetBytes(msg)
   Try
  
   ServerSocketSendTo(sendBytes remoteEP)
  
   Catch e As Exception
   ConsoleWriteLine(eToString())
   End Try
   End Sub
  
  #End Region
  
  End Module
  
  以下是客戶端:
  
  Imports SystemNet
  Imports SystemNetSockets
  Imports SystemText
  Imports SystemThreading
  
  
  Module Module
  
  #Region 參數
  
   以下是客戶端到服務器端的消息開頭
   Const LOGININ As String = 請求登陸的消息|||消息形式:+自己的用戶名
   Const LOGINOUT As String = 請求登出的消息|||消息形式:+自己的用戶名
   Const GETULIST As String = 請求獲得在線用戶列表|||消息形式:+自己的用戶名
   Const PPCONN As String = 請求PP連接的消息|||消息形式:+自己的用戶名+對方的用戶名
   Const HOLDLINE As String = 保持連接|||消息開式:+自己的用戶名
  
   以下是服務器到客戶端的消息開頭
   Const HVUSER As String = 用戶名已存在
   Const GETUSER As String = 在線用戶列表|||消息格式:+用戶名+EP
   Const MAKHOLD As String = 打洞命令|||消息格式:+IP
   Const LOGINOK As String = 登陸成功
   Const SERVCLS As String = 服務器關閉
   Const MSGEND As String = 消息結束
  
   以下是客戶端到客戶端的消息開頭
   Const HOLDOK As String = 打洞成功
   Const CHATMSG As String = 聊天消息
   Const CHTMSGEND As String = 聊天消息發送成功
  
   以下是客戶端的命名
   Const EXITPRO As String = EXIT 退出命令
   Const SHOWULIST As String = SHOWUSER 顯示在線用戶
   Const HELP As String = HELP 顯示幫助
   Const SEND As String = SEND 發送消息
  
  #End Region
  
  #Region 全局全量
  
   Delegate Sub myMethodDelegate(ByRef myInData As Byte()) 登陸時用的事件
  
   Dim MaxTry As Integer =
   Dim msgSendEnd As Boolean = False 消息是否發送成功若發送成功則會返回結束消息
   Dim ThListen As New Thread(AddressOf listen) 監聽的線程
   Dim ClientSocket As New Socket(AddressFamilyInterNetwork SocketTypeDgram ProtocolTypeUdp) 客戶端套節字的定義

   Dim username As String 當前用戶名
   Dim ServerEP As IPEndPoint 服務器的IPEP
   Dim holdBytes As [Byte]() = EncodingUnicodeGetBytes(HOLDLINE & username) 和服務器保持連接連接時用到的byte數組
 
  Dim OLUserName() As String
   Dim OLUserEP() As IPEndPoint
   Dim getUrecCount As Integer
   Dim testHold As Boolean = False
   Dim testChat As Boolean = False
  
   Private receiveDone As ManualResetEvent 在登陸時用來阻塞線程等待收到數據
   Private sendDone As ManualResetEvent 用來陰塞發送消息的線程等待收到回送的確認消息
   Private getUDone As ManualResetEvent 用來阻塞請求好友名單的線程等待接收好友名單
   Private holdDone As ManualResetEvent 用來阻塞打洞時的線程
   Private chatDone As ManualResetEvent 用來阻塞發送聊天消息時的線程
  
   Dim timerDelegate As New TimerCallback(AddressOf holdonline) 為保持在線狀態弄得
  
  #End Region
  
  #Region 方法
  
   主函數程序入口
   Sub Main()
   Dim InputIP As String
   Dim InputOK As Boolean = False
  
  
   判斷輸入的IP並且保存服務器的IPEP
   While InputOK <> True
   ConsoleWrite(請輸入服務器IP:)
   InputIP = ConsoleReadLine()
   Try
   ServerEP = New IPEndPoint(IPAddressParse(InputIP) )
   InputOK = True
   Catch
   ConsoleWriteLine(你輸入的服務器IP不正確請重新輸入)
   InputOK = False
   End Try
   End While
  
   Dim bool As Boolean = False
  
   判斷用戶是否登陸成功
   While bool <> True
  
   Dim LoginOK As Boolean = Login()
   If LoginOK = True Then
   bool = True
   Else
   ConsoleWrite(是否重試:輸入Y重試輸入任意值退出程序:)
   Dim tempYN As String = ConsoleReadLineToUpper
   If tempYN = Y Then
   bool = False
   Else
   Exit Sub
   End If
   End If
  
   End While
  
   ConsoleWriteLine(用戶名: & username)
   holdBytes = EncodingUnicodeGetBytes(HOLDLINE & username)
   登陸成功後用一個timer每隔秒向服務器發送消息保持在線狀態跟在主機注冊的端口
   Dim timer As New Timer(timerDelegate Nothing )
  
   請求在線名單
   ConsoleWriteLine(正在獲取在線名單請稍後)
   Dim getUbool As Boolean = False
   While getUbool <> True
   getUbool = getU()
   If getUbool = False Then
   ConsoleWrite(是否重試:輸入Y重試輸入任意值退出程序:)
   Dim tempYN As String = ConsoleReadLineToUpper
   If tempYN = Y Then
   bool = False
   Else
   Exit Sub
   End If
   End If
   End While
  
   ThListenStart()
  
   用來處理客戶端的一些命令
   Dim SVInput As String
   While True
   ConsoleWrite(Client>)
   SVInput = ConsoleReadLine()ToUpper
   Select Case SVInput
   Case EXITPRO
   exitApp()
   ThListenAbort()
   ClientSocketClose()
   Exit Sub
   Case SHOWULIST
   ConsoleWriteLine(*********************************)
   showUserList()
   ConsoleWriteLine(*********************************)
   Case HELP
   ConsoleWrite(********************************* & Chr() & Chr() & exit:輸出當前程序 & Chr() & Chr() & showuser:顯示當前在線用戶例表 & Chr() & Chr() & send:發送消息格式:send 用戶名 消息 & Chr() & Chr() & help:顯示幫助 & Chr() & Chr() & ********************************* & Chr() & Chr())
   Case Else
   If SVInputSubstring( ) = SEND Then
   Dim split() As String = SVInputSplit( )
   If splitLength = Then
   sendChatMsg(split() split())
   Else
   ConsoleWriteLine(********************************* & Chr() & Chr() & 你輸入的命令格式不正確send命令格式為:send 用戶名 你的消息 & Chr() & Chr() & *********************************)
   End If
   Else
   ConsoleWriteLine(********************************* & Chr() & Chr() & 笨瓜你輸入的不是有效的命令 & Chr() & Chr() & *********************************)
   End If
   End Select
   End While
  
   End Sub
  
   登陸函數
   Private Function Login() As Boolean
  
   receiveDone = New ManualResetEvent(False)
   Dim userBytes As [Byte]()
  
   Dim userOK As Boolean = False
  
   ConsoleWrite(請輸入你的用戶名:)
  
   判斷用戶名是否符合格式
   While (userOK <> True)
   username = ConsoleReadLineToUpper
   userBytes = EncodingUnicodeGetBytes(LOGININ & username)
  
   If userBytesLength > Or userBytesLength < Then
   ConsoleWriteLine(用戶名不得小於個字節且不得大於個字節)
   ConsoleWrite(請重新輸入你的用戶名:)
   Else
   userOK = True
   End If
   End While
  
   向服務器發送客戶消息
   ClientSocketSendTo(userBytes ServerEP)
  
   Dim data As [Byte]() = New Byte() {}
  
   Dim comStr As String = EncodingUnicodeGetString(data )
  
   異面的接收服務器回送的消息
   Dim DGrecv As New myMethodDelegate(AddressOf recvLogin)
   DGrecvBeginInvoke(data Nothing Nothing)
  
   等待服務器回送消息的時長為秒否則為服務器超時
   receiveDoneWaitOne( True)
  
   Dim recvStr As String = EncodingUnicodeGetString(data )
  
   If recvStr = comStr Then
   ConsoleWriteLine(服務器超時登陸失敗!!)
   Return False
   End If
  
   If EncodingUnicodeGetString(data ) = LOGINOK Then
   ConsoleWriteLine(登陸成功!!)
   Return True
   ElseIf EncodingUnicodeGetString(data ) = HVUSER Then
   ConsoleWriteLine(用戶名重復登陸失敗!!)
   Return False
   Else
   ConsoleWriteLine(服務器未知錯誤登陸失敗!!)
   Return False
   End If
  
   End Function
  
   登出函數
   Private Sub exitApp()
  
   Dim loginOutStr As String = LOGINOUT & username
   Dim sendBytes As [Byte]() = EncodingUnicodeGetBytes(loginOutStr)
   ClientSocketSendTo(sendBytes ServerEP)
  
   End Sub
  
   請求好友列表的函數
   Private Function getU() As Boolean
  
   getUDone = New ManualResetEvent(False)
   Dim getUbytes As Byte() = EncodingUnicodeGetBytes(GETULIST)
   ClientSocketSendTo(getUbytes ServerEP)
  
   Dim data As [Byte]() = New Byte() {}
   Dim comStr As String = EncodingUnicodeGetString(data )
  
   Dim GUrecv As New myMethodDelegate(AddressOf recvGetU)
   GUrecvBeginInvoke(data Nothing Nothing)
  
   getUDoneWaitOne( True)
  
   Dim recvStr As String = EncodingUnicodeGetString(data )
  
   If recvStr = comStr Then
   ConsoleWriteLine(服務器超時或取好友名單失敗!!)
   Return False
   End If
  
   If EncodingUnicodeGetString(data ) = GETUSER Then
   getUserList(data getUrecCount)
   ConsoleWriteLine(獲取在線名單成功!!)
   showUserList()
   Return True
   Else
   ConsoleWriteLine(服務器未知錯誤獲取在線名單失敗!!)
   Return False
   End If
  
   End Function
  
   登陸時用來異步的接收服務器發送的消息
   Sub recvLogin(ByRef inData As Byte())
  
   ClientSocketReceive(inData)
   receiveDoneSet()
  
   End Sub
  
   請求好友名單時用來異步接收服務器發送的消息
   Sub recvGetU(ByRef inData As Byte())
  
   getUrecCount = ClientSocketReceive(inData)
   getUDoneSet()
  
   End Sub
  
   處理收到的在線用戶信息
   Private Sub getUserList(ByVal userInfobytes() As Byte ByVal reccount As Integer)
  
   Dim ustr As String = EncodingUnicodeGetString(userInfobytes reccount )
  
   Dim splitStr() As String = Nothing
  
   splitStr = UstrSplit(|)
  
   Dim IPEPSplit() As String = Nothing
  
   Dim i As Integer =
  
   Dim k As Integer
   For k = To splitStrLength Step
   ReDim Preserve OLUserName(i)
   ReDim Preserve OLUserEP(i)
  
   OLUserName(i) = splitStr(k)
   IPEPSplit = splitStr(k + )Split(:)
   OLUserEP(i) = New IPEndPoint(IPAddressParse(IPEPSplit()) IPEPSplit())
  
   IPEPSplit = Nothing
   i +=
   Next
  
   End Sub
  
   顯示在線用戶
   Private Sub showUserList()
   Dim i As Integer
   For i = To OLUserNameLength
   If OLUserName(i) <> Then
   ConsoleWriteLine(用戶名: & OLUserName(i) & 用戶IP: & OLUserEP(i)ToString)
   End If
   Next
   End Sub
  
   客戶程序監聽的函數
   Sub listen()
  
   While True
  
   Try
   Dim recv As Integer = 收到的字節數
   Dim data As [Byte]() = New Byte() {} 緩沖區大小
   Dim sender As New IPEndPoint(IPAddressAny )
   Dim tempRemoteEP As EndPoint = CType(sender EndPoint)
   recv = ClientSocketReceiveFrom(data tempRemoteEP)
  
   Dim msgHead As String = EncodingUnicodeGetString(data ) 獲得消息頭的內容
   Select Case msgHead
   Case MSGEND
   msgSendEnd = True
   sendDoneSet()
   Case LOGININ
   addOnLine(data recv)
   Case LOGINOUT
   removeOnLine(data recv)
   Case MSGEND
   msgSendEnd = True
   sendDoneSet()
   Case MAKHOLD
   ConsoleWriteLine(Chr() & Chr() & 收到打洞消息)
   makeHold(data recv)
   ConsoleWrite(Client>)
   Case CHATMSG
   showChatMsg(data recv)
   Case HOLDOK
   testHold = True
   holdDoneSet()
   Case CHTMSGEND
   testChat = True
   chatDoneSet()
   End Select
  
   Catch
   End Try
  
   End While
   End Sub
  
   發送聊天消息
   Private Sub sendChatMsg(ByVal remoteUser As String ByVal chatMsgStr As String)
  
   If remoteUser = username Then
   ConsoleWriteLine(豬頭你想干什麼!!!)
   Exit Sub
   End If
  
   Dim i As Integer
  
   Dim remoteUEP As IPEndPoint
   For i = To OLUserNameLength
   If remoteUser = OLUserName(i) Then
   remoteUEP = OLUserEP(i)
   Exit For
   End If
   If i = OLUserNameLength Then
   ConsoleWriteLine(找不到你想發送的用戶)
   Exit Sub
   End If
   Next
  
   Dim msgbytes() As Byte = EncodingUnicodeGetBytes(CHATMSG & username & | & chatMsgStr)
   Dim holdbytes() As Byte = EncodingUnicodeGetBytes(PPCONN & username & | & remoteUser)
  
   chatDone = New ManualResetEvent(False)
   ClientSocketSendTo(msgbytes remoteUEP)
   chatDoneWaitOne( True)
   If testChat = True Then
   testChat = False
   Exit Sub
   End If
  
   testHold = False
   While testHold <> True
   ConsoleWriteLine(打洞ing)
   holdDone = New ManualResetEvent(False)
   ClientSocketSendTo(holdbytes remoteUEP)
   ClientSocketSendTo(holdbytes ServerEP)
   holdDoneWaitOne( True)
   If testHold = True Then
   Exit While
   Else
   ConsoleWriteLine(打洞超時發送消息失敗)
   ConsoleWrite(是否重試按Y重試按任意值結束發送:)
   Dim YorN As String = ConsoleReadLine()ToUpper
   If YorN = Y Then
   testHold = False
   Else
   Exit Sub
   End If
   End If
   End While
  
   While testChat <> True
   ConsoleWriteLine(打洞成功正在准備發送)
   chatDone = New ManualResetEvent(False)
   ClientSocketSendTo(msgbytes remoteUEP)
   chatDoneWaitOne( True)
   If testChat = True Then
   ConsoleWriteLine(消息發送成功!!)
   Exit While
   Else
   ConsoleWriteLine(發送超時發送消息失敗)
   ConsoleWrite(是否重試按Y重試按任意值結束發送:)
   Dim YorN As String = ConsoleReadLine()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 = EncodingUnicodeGetString(indata recvcount )
   Dim splitStr() As String = msgStrSplit(|)
   Dim fromUname As String = splitStr()
   Dim msg As String = splitStr()
   ConsoleWriteLine(Chr() & Chr() & 收到來自 & fromUname & 的消息: & msg)
   ConsoleWrite(Client>)
   Dim i As Integer
   For i = To OLUserNameLength
   If OLUserName(i) = fromUname Then
   Exit For
   End If
   Next
   Dim tempbytes() As Byte = EncodingUnicodeGetBytes(CHTMSGEND)
   ClientSocketSendTo(tempbytes OLUserEP(i))
   End Sub
  
   處理打洞函數
   Private Sub makeHold(ByVal indata() As Byte ByVal recvcount As Integer)
   Dim makholdstr As String = EncodingUnicodeGetString(indata recvcount)
   Dim ipepstr() As String = makholdstrSplit(:)
   Dim holdEP As IPEndPoint = New IPEndPoint(IPAddressParse(ipepstr()) ipepstr())
  
   Dim holdbytes() As Byte = EncodingUnicodeGetBytes(HOLDOK & username)
   ClientSocketSendTo(holdbytes holdEP)
   ConsoleWriteLine(回送打洞消息)
   End Sub
  
   處理用戶上線的函數
   Private Sub addOnLine(ByVal inData() As Byte ByVal recvCount As Integer)
   Dim inStr As String = EncodingUnicodeGetString(inData recvCount )
   Dim userinfo() As String = inStrSplit(|)
   Dim strUserEP() As String = userinfo()Split(:)
  
   Dim i As Integer
   For i = To OLUserNameLength
   If OLUserName(i) = Then
   OLUserName(i) = userinfo()
   OLUserEP(i) = New IPEndPoint(IPAddressParse(strUserEP()) strUserEP())
   ConsoleWriteLine(Chr() & Chr() & 用戶 & OLUserName(i) & 上線了 用戶地址: & OLUserEP(i)ToString)
   ConsoleWrite(Client>)
   Exit Sub
   End If
   Next
  
   ReDim Preserve OLUserName(i + )
   ReDim Preserve OLUserEP(i + )
  
   OLUserName(i + ) = userinfo()
   OLUserEP(i + ) = New IPEndPoint(IPAddressParse(strUserEP()) strUserEP())
  
   ConsoleWriteLine(Chr() & Chr() & 用戶 & OLUserName(i + ) & 上線了 用戶地址: & OLUserEP(i + )ToString)
   ConsoleWrite(Client>)
  
   End Sub
  
   處理用戶下線的函數
   Private Sub removeOnLine(ByVal inData() As Byte ByVal recvCount As Integer)
   Dim offUname As String = EncodingUnicodeGetString(inData recvCount )
  
   Dim i As Integer
   For i = To OLUserNameLength
   If OLUserName(i) = offUname Then
   OLUserName(i) =
   OLUserEP(i) = Nothing
   ConsoleWriteLine(Chr() & Chr() & 用戶 & offUname & 下線了)
   ConsoleWrite(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]() = EncodingUnicodeGetBytes(msg)
  
   判斷發送的字節數是否超過了服務器緩沖區大小
   If sendBytesLength > Then
   Return W輸入的字數太多
   End If
  
   判斷消息是否發送成功
   While msgSendEnd = False
  
   sendDone = New ManualResetEvent(False)
  
   Try
  
   ClientSocketSendTo(sendBytes sendToIPEP)
  
   sendDoneWaitOne( True) 阻塞線程秒
  
   If msgSendEnd = False Then
   ConsoleWriteLine(消息發送超時)
   Else
   Exit While
   End If
  
   Catch e As Exception
  
   ConsoleWriteLine(發送消息失敗 & eToString)
   Exit Function
  
   End Try
  
   ConsoleWrite(是否重試?按Y重試按任意鍵退出:)
   Dim userInput As String = ConsoleReadLineToUpper
  
   If userInput = Y Then
   Else
   msgSendEnd = False
   Exit Function
   End If
  
   End While
  
   msgSendEnd = False
  
   End Function
  
   用保持在線狀態的函數
   Private Sub holdonline(ByVal state As [Object])
   ClientSocketSendTo(holdBytes ServerEP)
   End Sub
  
  #End Region
  
  End Module
From:http://tw.wingwit.com/Article/program/net/201311/13617.html