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