P2P的简单示例:VB.net版

这是用VB.net实现的一个简单的P2P示例.利用了UDP打洞技术.分服务器端跟客户端.服务器端负责登陆记录用户的IP和端口及转发打洞消息.(相关技术在CSDN搜一下.有很多的.).原理到处都有,这里就没有贴出来.这里贴出了VB.net的代码.供初学者交流.也欢迎高手点评...

服务器端在启动成功后.输入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

以下是客户端:

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


Module Module1

#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 HOLDOK As String = "30" @#打洞成功
Const CHATMSG As String = "31" @#聊天消息
Const CHTMSGEND As String = "32" @#聊天消息发送成功

@#以下是客户端的命名
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 = 5
Dim msgSendEnd As Boolean = False @#消息是否发送成功,若发送成功,则会返回结束消息
Dim ThListen As New Thread(AddressOf listen) @#监听的线程
Dim ClientSocket As New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp) @#客户端套节字的定义
Dim username As String @#当前用户名
Dim ServerEP As IPEndPoint @#服务器的IPEP
Dim holdBytes As [Byte]() = Encoding.Unicode.GetBytes(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
Console.Write("请输入服务器IP:")
InputIP = Console.ReadLine()
Try
ServerEP = New IPEndPoint(IPAddress.Parse(InputIP), 11000)
InputOK = True
Catch
Console.WriteLine("你输入的服务器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
Console.Write("是否重试:输入Y重试,输入任意值退出程序:")
Dim tempYN As String = Console.ReadLine.ToUpper
If tempYN = "Y" Then
bool = False
Else
Exit Sub
End If
End If

End While

Console.WriteLine("用户名:" & username)
holdBytes = Encoding.Unicode.GetBytes(HOLDLINE & username)
@#登陆成功后.用一个timer,每隔50秒向服务器发送消息,保持在线状态跟在主机注册的端口
Dim timer As New Timer(timerDelegate, Nothing, 10000, 50000)

@#请求在线名单
Console.WriteLine("正在获取在线名单,请稍后....")
Dim getUbool As Boolean = False
While getUbool <> True
getUbool = getU()
If getUbool = False Then
Console.Write("是否重试:输入Y重试,输入任意值退出程序:")
Dim tempYN As String = Console.ReadLine.ToUpper
If tempYN = "Y" Then
bool = False
Else
Exit Sub
End If
End If
End While

ThListen.Start()

@#用来处理客户端的一些命令
Dim SVInput As String
While True
Console.Write("Client>")
SVInput = Console.ReadLine().ToUpper
Select Case SVInput
Case EXITPRO
exitApp()
ThListen.Abort()
ClientSocket.Close()
Exit Sub
Case SHOWULIST
Console.WriteLine("*********************************")
showUserList()
Console.WriteLine("*********************************")
Case HELP
Console.Write("*********************************" & Chr(10) & Chr(13) & "exit:输出当前程序" & Chr(10) & Chr(13) & "showuser:显示当前在线用户例表" & Chr(10) & Chr(13) & "send:发送消息.格式:send 用户名 消息" & Chr(10) & Chr(13) & "help:显示帮助" & Chr(10) & Chr(13) & "*********************************" & Chr(10) & Chr(13))
Case Else
If SVInput.Substring(0, 4) = "SEND" Then
Dim split() As String = SVInput.Split(" ")
If split.Length = 3 Then
sendChatMsg(split(1), split(2))
Else
Console.WriteLine("*********************************" & Chr(10) & Chr(13) & "你输入的命令格式不正确.send命令格式为:send 用户名 你的消息" & Chr(10) & Chr(13) & "*********************************")
End If
Else
Console.WriteLine("*********************************" & Chr(10) & Chr(13) & "笨瓜,你输入的不是有效的命令." & Chr(10) & Chr(13) & "*********************************")
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

Console.Write("请输入你的用户名:")

@#判断用户名是否符合格式
While (userOK <> True)
username = Console.ReadLine.ToUpper
userBytes = Encoding.Unicode.GetBytes(LOGININ & username)

If userBytes.Length > 24 Or userBytes.Length < 10 Then
Console.WriteLine("用户名不得小于6个字节,且不得大于20个字节.")
Console.Write("请重新输入你的用户名:")
Else
userOK = True
End If
End While

@#向服务器发送客户消息
ClientSocket.SendTo(userBytes, ServerEP)

Dim data As [Byte]() = New Byte(1024) {}

Dim comStr As String = Encoding.Unicode.GetString(data, 0, 4)

@#异面的接收服务器回送的消息
Dim DGrecv As New myMethodDelegate(AddressOf recvLogin)
DGrecv.BeginInvoke(data, Nothing, Nothing)

@#等待服务器回送消息的时长为10秒,否则为服务器超时
receiveDone.WaitOne(30000, True)

Dim recvStr As String = Encoding.Unicode.GetString(data, 0, 4)

If recvStr = comStr Then
Console.WriteLine("服务器超时.登陆失败!!")
Return False
End If

If Encoding.Unicode.GetString(data, 0, 4) = LOGINOK Then
Console.WriteLine("登陆成功!!")
Return True
ElseIf Encoding.Unicode.GetString(data, 0, 4) = HVUSER Then
Console.WriteLine("用户名重复.登陆失败!!")
Return False
Else
Console.WriteLine("服务器未知错误,登陆失败!!")
Return False
End If

End Function

@#登出函数
Private Sub exitApp()

Dim loginOutStr As String = LOGINOUT & username
Dim sendBytes As [Byte]() = Encoding.Unicode.GetBytes(loginOutStr)
ClientSocket.SendTo(sendBytes, ServerEP)

End Sub

@#请求好友列表的函数
Private Function getU() As Boolean

getUDone = New ManualResetEvent(False)
Dim getUbytes As Byte() = Encoding.Unicode.GetBytes(GETULIST)
ClientSocket.SendTo(getUbytes, ServerEP)

Dim data As [Byte]() = New Byte(4056) {}
Dim comStr As String = Encoding.Unicode.GetString(data, 0, 4)

Dim GUrecv As New myMethodDelegate(AddressOf recvGetU)
GUrecv.BeginInvoke(data, Nothing, Nothing)

getUDone.WaitOne(30000, True)

Dim recvStr As String = Encoding.Unicode.GetString(data, 0, 4)

If recvStr = comStr Then
Console.WriteLine("服务器超时.或取好友名单失败!!")
Return False
End If

If Encoding.Unicode.GetString(data, 0, 4) = GETUSER Then
getUserList(data, getUrecCount)
Console.WriteLine("获取在线名单成功!!")
showUserList()
Return True
Else
Console.WriteLine("服务器未知错误,获取在线名单失败!!")
Return False
End If

End Function

@#登陆时用来异步的接收服务器发送的消息
Sub recvLogin(ByRef inData As Byte())

ClientSocket.Receive(inData)
receiveDone.Set()

End Sub

@#请求好友名单时用来异步接收服务器发送的消息
Sub recvGetU(ByRef inData As Byte())

getUrecCount = ClientSocket.Receive(inData)
getUDone.Set()

End Sub

@#处理收到的在线用户信息
Private Sub getUserList(ByVal userInfobytes() As Byte, ByVal reclearcase/" target="_blank" >ccount As Integer)

Dim ustr As String = Encoding.Unicode.GetString(userInfobytes, 4, reccount - 4)

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

原文转自：http://www.ltesting.net