Imports System.Net Imports System.Net.Sockets Imports System.Text Imports System.Threading Imports System.Collections Module myUDPServerModule myUDPServer 全局变量#Region "全局变量" Dim ServerSocket AsNew Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp) Dim ipep As IPEndPoint =New IPEndPoint(IPAddress.Any, 11000) Dim htUserList AsNew Hashtable ''''用来保存在线用户和用户的"IP和端口" Dim userName(0) AsString Dim userIPEP(0) As IPEndPoint Dim userTime(0) AsInteger Dim timerDelegate AsNew TimerCallback(AddressOf onLineTimeOut) #End Region 参数#Region "参数" ''''以下是客户端到服务器端的消息开头 Const LOGININ AsString="10"''''请求登陆的消息|||消息形式:10+自己的用户名 Const LOGINOUT AsString="11"''''请求登出的消息|||消息形式:11+自己的用户名 Const GETULIST AsString="12"''''请求获得在线用户列表|||消息形式:12 Const P2PCONN AsString="13"''''请求P2P连接的消息|||消息形式:13+自己的用户名+|+对方的用户名 Const HOLDLINE AsString="14"''''保持连接.|||消息开式:14+自己的用户名 ''''以下是服务器到客户端的消息开头 Const HVUSER AsString="20"''''用户名已存在 Const GETUSER AsString="21"''''在线用户列表|||消息格式:21+用户名+EP Const MAKHOLD AsString="22"''''打洞命令|||消息格式:22+IP Const LOGINOK AsString="23"''''登陆成功 Const SERVCLS AsString="24"''''服务器关闭 Const MSGEND AsString="25"''''消息结束 ''''以下是服务器端的命名 Const EXITPRO AsString="EXIT"''''退出命令 Const SHOWULIST AsString="SHOWUSER"''''显示在线用户 Const HELP AsString="HELP"''''显示帮助 #End Region 方法#Region "方法" ''''主函数,程序入口 Sub Main()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 AsNew Thread(AddressOf listen) listenTH.Start() ''''启用监听的线程 Console.WriteLine("服务器启动成功.....") Dim timer AsNew Timer(timerDelegate, Nothing, 0, 5000) Dim SVInput AsString WhileTrue Console.Write("Server>") SVInput = Console.ReadLine().ToUpper SelectCase 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)) CaseElse Console.WriteLine("*********************************"&Chr(10) &Chr(13) &"笨瓜,你输入的不是有效的命令."&Chr(10) &Chr(13) &"*********************************") EndSelect EndWhile End Sub ''''打印在线用户 Sub showUser()Sub showUser() Dim hava AsBoolean=False If userName.Length <>0Then Dim i AsInteger For i =1To userName.Length -1 If userName(i) <>""Then hava =True ExitFor EndIf Next If hava =FalseThen Console.WriteLine("*********************************"&Chr(10) &Chr(13) &"当前没有用户在线"&Chr(10) &Chr(13) &"*********************************") Exit Sub EndIf Console.WriteLine("*********************************") For i =1To userName.Length -1 If userName(i) <>""Then Console.WriteLine("用户名:"& userName(i) &" 地址:"& userIPEP(i).ToString) EndIf Next Console.WriteLine("*********************************") Else Console.WriteLine("*********************************"&Chr(10) &Chr(13) &"当前没有用户在线"&Chr(10) &Chr(13) &"*********************************") EndIf End Sub ''''服务器监听函数 Sub listen()Sub listen() WhileTrue Try Dim recv AsInteger=0 Dim data As [Byte]() =NewByte(1024) {} Dim sender AsNew IPEndPoint(IPAddress.Any, 0) Dim tempRemoteEP As EndPoint =CType(sender, EndPoint) recv = ServerSocket.ReceiveFrom(data, tempRemoteEP) ''''Console.WriteLine(Encoding.Unicode.GetString(data)) Dim msgHead AsString= Encoding.Unicode.GetString(data, 0, 4) SelectCase msgHead Case LOGININ Dim LoginThing AsString= userLogin(data, tempRemoteEP, recv) If LoginThing = HVUSER Then sendMsg(HVUSER, tempRemoteEP) ElseIf LoginThing = LOGINOK Then sendMsg(LOGINOK, tempRemoteEP) EndIf Case LOGINOUT userloginout(data, recv) Case GETULIST Dim userinfo AsString= getUserList() sendMsg(userinfo, tempRemoteEP) Case P2PCONN questP2PConn(data, recv) Case HOLDLINE holdOnLine(data, recv) EndSelect Catch e As Exception ''''Console.WriteLine(e.ToString) EndTry EndWhile End Sub ''''转发P2P连接请求 PrivateSub questP2PConn()Sub questP2PConn(ByVal data() AsByte, ByVal recv AsInteger) Dim recvStr AsString= Encoding.Unicode.GetString(data, 4, recv -4) Dimsplit() AsString= recvStr.Split("|") Dim fromEP As IPEndPoint Dim toEP As IPEndPoint Dim i AsInteger For i =1To userName.Length -1 If userName(i) =split(0) Then fromEP = userIPEP(i) EndIf If userName(i) =split(1) Then toEP = userIPEP(i) EndIf Next Dim holdbytes() AsByte= Encoding.Unicode.GetBytes(MAKHOLD & fromEP.ToString) ServerSocket.SendTo(holdbytes, toEP) End Sub ''''函数.返回所有在线用户.其格式:用户名+|+用户IPEP+| PrivateFunction getUserList()Function getUserList() AsString Dim userInfo AsString= GETUSER Dim i AsInteger For i =1To userName.Length -1 If userName(i) <>""Then userInfo += userName(i) &"|"& userIPEP(i).ToString &"|" EndIf Next Return userInfo End Function ''''用户登陆,直接返回登陆是否成功的值 PrivateFunction userLogin()Function userLogin(ByVal data AsByte(), ByVal userEP As IPEndPoint, ByVal recvCount AsInteger) AsString Dim Uname AsString= Encoding.Unicode.GetString(data, 4, recvCount -4) Dim Uinfobytes() AsByte Dim i AsInteger Dim j AsInteger For i =1To userName.Length -1 If Uname = userName(i) Then Return HVUSER EndIf Next For i =1To 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 =1To userName.Length -1 If userName(j) <>""And userName(j) <> Uname Then ServerSocket.SendTo(Uinfobytes, userIPEP(j)) EndIf Next Return LOGINOK EndIf Next Dim userCount AsInteger= userName.Length ReDimPreserve userName(userCount) ReDimPreserve userIPEP(userCount) ReDimPreserve 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 =1To userName.Length -1 If userName(j) <>""And userName(j) <> Uname Then ServerSocket.SendTo(Uinfobytes, userIPEP(j)) EndIf Next Return LOGINOK End Function ''''用户登出 PrivateSub userloginout()Sub userloginout(ByVal data AsByte(), ByVal recvCount AsInteger) Dim i AsInteger Dim Uname AsString= Encoding.Unicode.GetString(data, 4, recvCount -4) For i =1To userName.Length -1 If Uname = userName(i) Then Dim loginOutMsg AsString= LOGINOUT & userName(i) userName(i) ="" userIPEP(i) =Nothing userTime(i) =0 Dim j AsInteger For j =1To userName.Length -1 If userName(j) <>""Then sendMsg(loginOutMsg, userIPEP(j)) EndIf Next Console.WriteLine(Chr(10) &Chr(13) &"*********************************") Console.WriteLine("用户"& Uname &"下线了.") Console.WriteLine("*********************************") Console.Write("Server>") ExitFor EndIf Next End Sub ''''保持用户在线的过程 PrivateSub holdOnLine()Sub holdOnLine(ByVal data AsByte(), ByVal recvCount AsInteger) Dim Uname AsString= Encoding.Unicode.GetString(data, 4, recvCount -4) Dim i AsInteger For i =1To userName.Length -1 If Uname = userName(i) Then userTime(i) =60 ExitFor EndIf Next End Sub ''''用户超时退出 PrivateSub onLineTimeOut()Sub onLineTimeOut(ByVal state As [Object]) Dim i AsInteger For i =1To userName.Length -1 If userTime(i) >0Then userTime(i) -=5 If userTime(i) <=0Then Dim loginoutmsg AsString= 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() AsByte= Encoding.Unicode.GetBytes(loginoutmsg) Dim j AsInteger For j =1To userName.Length -1 If userName(j) <>""Then If userIPEP(j) IsNothingThen Else ServerSocket.SendTo(ULoginOutbytes, userIPEP(j)) EndIf EndIf Next EndIf EndIf Next End Sub ''''发送消息的函数 Sub sendMsg()Sub sendMsg(ByVal msg AsString, 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()) EndTry End Sub #End Region End Module 以下是客户端: Imports System.Net Imports System.Net.Sockets Imports System.Text Imports System.Threading Module Module1Module Module1 参数#Region "参数" ''''以下是客户端到服务器端的消息开头 Const LOGININ AsString="10"''''请求登陆的消息|||消息形式:10+自己的用户名 Const LOGINOUT AsString="11"''''请求登出的消息|||消息形式:11+自己的用户名 Const GETULIST AsString="12"''''请求获得在线用户列表|||消息形式:12+自己的用户名 Const P2PCONN AsString="13"''''请求P2P连接的消息|||消息形式:13+自己的用户名+对方的用户名 Const HOLDLINE AsString="14"''''保持连接.|||消息开式:14+自己的用户名 ''''以下是服务器到客户端的消息开头 Const HVUSER AsString="20"''''用户名已存在 Const GETUSER AsString="21"''''在线用户列表|||消息格式:21+用户名+EP Const MAKHOLD AsString="22"''''打洞命令|||消息格式:22+IP Const LOGINOK AsString="23"''''登陆成功 Const SERVCLS AsString="24"''''服务器关闭 Const MSGEND AsString="25"''''消息结束 ''''以下是客户端到客户端的消息开头 Const HOLDOK AsString="30"''''打洞成功 Const CHATMSG AsString="31"''''聊天消息 Const CHTMSGEND AsString="32"''''聊天消息发送成功 ''''以下是客户端的命名 Const EXITPRO AsString="EXIT"''''退出命令 Const SHOWULIST AsString="SHOWUSER"''''显示在线用户 Const HELP AsString="HELP"''''显示帮助 Const SEND AsString="SEND"''''发送消息 #End Region 全局全量#Region "全局全量" DelegateSub myMethodDelegate()Sub myMethodDelegate(ByRef myInData AsByte()) ''''登陆时用的事件 ''''Dim MaxTry As Integer = 5 Dim msgSendEnd AsBoolean=False''''消息是否发送成功,若发送成功,则会返回结束消息 Dim ThListen AsNew Thread(AddressOf listen) ''''监听的线程 Dim ClientSocket AsNew Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp) ''''客户端套节字的定义 Dim username AsString''''当前用户名 Dim ServerEP As IPEndPoint ''''服务器的IPEP Dim holdBytes As [Byte]() = Encoding.Unicode.GetBytes(HOLDLINE & username) ''''和服务器保持连接连接时用到的byte数组 Dim OLUserName() AsString Dim OLUserEP() As IPEndPoint Dim getUrecCount AsInteger Dim testHold AsBoolean=False Dim testChat AsBoolean=False Private receiveDone As ManualResetEvent ''''在登陆时用来阻塞线程,等待收到数据 Private sendDone As ManualResetEvent ''''用来阴塞发送消息的线程.等待收到回送的确认消息 Private getUDone As ManualResetEvent ''''用来阻塞请求好友名单的线程,等待接收好友名单 Private holdDone As ManualResetEvent ''''用来阻塞打洞时的线程 Private chatDone As ManualResetEvent ''''用来阻塞发送聊天消息时的线程 Dim timerDelegate AsNew TimerCallback(AddressOf holdonline) ''''为保持在线状态弄得 #End Region 方法#Region "方法" ''''主函数,程序入口 Sub Main()Sub Main() Dim InputIP AsString Dim InputOK AsBoolean=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 EndTry EndWhile Dim bool AsBoolean=False ''''判断用户是否登陆成功 While bool <>True Dim LoginOK AsBoolean= Login() If LoginOK =TrueThen bool =True Else Console.Write("是否重试:输入Y重试,输入任意值退出程序:") Dim tempYN AsString= Console.ReadLine.ToUpper If tempYN ="Y"Then bool =False Else Exit Sub EndIf EndIf EndWhile Console.WriteLine("用户名:"& username) holdBytes = Encoding.Unicode.GetBytes(HOLDLINE & username) ''''登陆成功后.用一个timer,每隔50秒向服务器发送消息,保持在线状态跟在主机注册的端口 Dim timer AsNew Timer(timerDelegate, Nothing, 10000, 50000) ''''请求在线名单 Console.WriteLine("正在获取在线名单,请稍后....") Dim getUbool AsBoolean=False While getUbool <>True getUbool = getU() If getUbool =FalseThen Console.Write("是否重试:输入Y重试,输入任意值退出程序:") Dim tempYN AsString= Console.ReadLine.ToUpper If tempYN ="Y"Then bool =False Else Exit Sub EndIf EndIf EndWhile ThListen.Start() ''''用来处理客户端的一些命令 Dim SVInput AsString WhileTrue Console.Write("Client>") SVInput = Console.ReadLine().ToUpper SelectCase 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)) CaseElse If SVInput.Substring(0, 4) ="SEND"Then Dimsplit() AsString= SVInput.Split("") Ifsplit.Length =3Then sendChatMsg(split(1), split(2)) Else Console.WriteLine("*********************************"&Chr(10) &Chr(13) &"你输入的命令格式不正确.send命令格式为:send 用户名 你的消息"&Chr(10) &Chr(13) &"*********************************") EndIf Else Console.WriteLine("*********************************"&Chr(10) &Chr(13) &"笨瓜,你输入的不是有效的命令."&Chr(10) &Chr(13) &"*********************************") EndIf EndSelect EndWhile End Sub ''''登陆函数 PrivateFunction Login()Function Login() AsBoolean receiveDone =New ManualResetEvent(False) Dim userBytes As [Byte]() Dim userOK AsBoolean=False Console.Write("请输入你的用户名:") ''''判断用户名是否符合格式 While (userOK <>True) username = Console.ReadLine.ToUpper userBytes = Encoding.Unicode.GetBytes(LOGININ & username) If userBytes.Length >24Or userBytes.Length <10Then Console.WriteLine("用户名不得小于6个字节,且不得大于20个字节.") Console.Write("请重新输入你的用户名:") Else userOK =True EndIf EndWhile ''''向服务器发送客户消息 ClientSocket.SendTo(userBytes, ServerEP) Dim data As [Byte]() =NewByte(1024) {} Dim comStr AsString= Encoding.Unicode.GetString(data, 0, 4) ''''异面的接收服务器回送的消息 Dim DGrecv AsNew myMethodDelegate(AddressOf recvLogin) DGrecv.BeginInvoke(data, Nothing, Nothing) ''''等待服务器回送消息的时长为10秒,否则为服务器超时 receiveDone.WaitOne(30000, True) Dim recvStr AsString= Encoding.Unicode.GetString(data, 0, 4) If recvStr = comStr Then Console.WriteLine("服务器超时.登陆失败!!") ReturnFalse EndIf If Encoding.Unicode.GetString(data, 0, 4) = LOGINOK Then Console.WriteLine("登陆成功!!") ReturnTrue ElseIf Encoding.Unicode.GetString(data, 0, 4) = HVUSER Then Console.WriteLine("用户名重复.登陆失败!!") ReturnFalse Else Console.WriteLine("服务器未知错误,登陆失败!!") ReturnFalse EndIf End Function ''''登出函数 PrivateSub exitApp()Sub exitApp() Dim loginOutStr AsString= LOGINOUT & username Dim sendBytes As [Byte]() = Encoding.Unicode.GetBytes(loginOutStr) ClientSocket.SendTo(sendBytes, ServerEP) End Sub ''''请求好友列表的函数 PrivateFunction getU()Function getU() AsBoolean getUDone =New ManualResetEvent(False) Dim getUbytes AsByte() = Encoding.Unicode.GetBytes(GETULIST) ClientSocket.SendTo(getUbytes, ServerEP) Dim data As [Byte]() =NewByte(4056) {} Dim comStr AsString= Encoding.Unicode.GetString(data, 0, 4) Dim GUrecv AsNew myMethodDelegate(AddressOf recvGetU) GUrecv.BeginInvoke(data, Nothing, Nothing) getUDone.WaitOne(30000, True) Dim recvStr AsString= Encoding.Unicode.GetString(data, 0, 4) If recvStr = comStr Then Console.WriteLine("服务器超时.或取好友名单失败!!") ReturnFalse EndIf If Encoding.Unicode.GetString(data, 0, 4) = GETUSER Then getUserList(data, getUrecCount) Console.WriteLine("获取在线名单成功!!") showUserList() ReturnTrue Else Console.WriteLine("服务器未知错误,获取在线名单失败!!") ReturnFalse EndIf End Function ''''登陆时用来异步的接收服务器发送的消息 Sub recvLogin()Sub recvLogin(ByRef inData AsByte()) ClientSocket.Receive(inData) receiveDone.Set() End Sub ''''请求好友名单时用来异步接收服务器发送的消息 Sub recvGetU()Sub recvGetU(ByRef inData AsByte()) getUrecCount = ClientSocket.Receive(inData) getUDone.Set() End Sub ''''处理收到的在线用户信息 PrivateSub getUserList()Sub getUserList(ByVal userInfobytes() AsByte, ByVal reccount AsInteger) Dim ustr AsString= Encoding.Unicode.GetString(userInfobytes, 4, reccount -4) Dim splitStr() AsString=Nothing splitStr = Ustr.Split("|") Dim IPEPSplit() AsString=Nothing Dim i AsInteger=0 Dim k AsInteger For k =0To splitStr.Length -2Step2 ReDimPreserve OLUserName(i) ReDimPreserve 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 ''''显示在线用户 PrivateSub showUserList()Sub showUserList() Dim i AsInteger For i =0To OLUserName.Length -1 If OLUserName(i) <>""Then Console.WriteLine("用户名:"& OLUserName(i) &" 用户IP:"& OLUserEP(i).ToString) EndIf Next End Sub ''''客户程序监听的函数 Sub listen()Sub listen() WhileTrue Try Dim recv AsInteger=0''''收到的字节数 Dim data As [Byte]() =NewByte(1024) {} ''''缓冲区大小 Dim sender AsNew IPEndPoint(IPAddress.Any, 0) Dim tempRemoteEP As EndPoint =CType(sender, EndPoint) recv = ClientSocket.ReceiveFrom(data, tempRemoteEP) Dim msgHead AsString= Encoding.Unicode.GetString(data, 0, 4) ''''获得消息头的内容 SelectCase 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() EndSelect Catch EndTry EndWhile End Sub ''''发送聊天消息 PrivateSub sendChatMsg()Sub sendChatMsg(ByVal remoteUser AsString, ByVal chatMsgStr AsString) If remoteUser = username Then Console.WriteLine("猪头,你想干什么!!!") Exit Sub EndIf Dim i AsInteger Dim remoteUEP As IPEndPoint For i =0To OLUserName.Length -1 If remoteUser = OLUserName(i) Then remoteUEP = OLUserEP(i) ExitFor EndIf If i = OLUserName.Length -1Then Console.WriteLine("找不到你想发送的用户.") Exit Sub EndIf Next Dim msgbytes() AsByte= Encoding.Unicode.GetBytes(CHATMSG & username &"|"& chatMsgStr) Dim holdbytes() AsByte= Encoding.Unicode.GetBytes(P2PCONN & username &"|"& remoteUser) chatDone =New ManualResetEvent(False) ClientSocket.SendTo(msgbytes, remoteUEP) chatDone.WaitOne(10000, True) If testChat =TrueThen testChat =False Exit Sub EndIf 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 =TrueThen ExitWhile Else Console.WriteLine("打洞超时,发送消息失败.") Console.Write("是否重试,按Y重试,按任意值结束发送:") Dim YorN AsString= Console.ReadLine().ToUpper If YorN ="Y"Then testHold =False Else Exit Sub EndIf EndIf EndWhile While testChat <>True Console.WriteLine("打洞成功,正在准备发送.....") chatDone =New ManualResetEvent(False) ClientSocket.SendTo(msgbytes, remoteUEP) chatDone.WaitOne(10000, True) If testChat =TrueThen Console.WriteLine("消息发送成功!!") ExitWhile Else Console.WriteLine("发送超时,发送消息失败.") Console.Write("是否重试,按Y重试,按任意值结束发送:") Dim YorN AsString= Console.ReadLine().ToUpper If YorN ="Y"Then testChat =False Else Exit Sub EndIf EndIf EndWhile testHold =False testChat =False End Sub ''''处理聊天消息 PrivateSub showChatMsg()Sub showChatMsg(ByVal indata() AsByte, ByVal recvcount AsInteger) Dim msgStr AsString= Encoding.Unicode.GetString(indata, 4, recvcount -4) Dim splitStr() AsString= msgStr.Split("|") Dim fromUname AsString= splitStr(0) Dim msg AsString= splitStr(1) Console.WriteLine(Chr(10) &Chr(13) &"收到来自"& fromUname &"的消息:"& msg) Console.Write("Client>") Dim i AsInteger For i =0To OLUserName.Length -1 If OLUserName(i) = fromUname Then ExitFor EndIf Next Dim tempbytes() AsByte= Encoding.Unicode.GetBytes(CHTMSGEND) ClientSocket.SendTo(tempbytes, OLUserEP(i)) End Sub ''''处理打洞函数 PrivateSub makeHold()Sub makeHold(ByVal indata() AsByte, ByVal recvcount AsInteger) Dim makholdstr AsString= Encoding.Unicode.GetString(indata, 4, recvcount) Dim ipepstr() AsString= makholdstr.Split(":") Dim holdEP As IPEndPoint =New IPEndPoint(IPAddress.Parse(ipepstr(0)), ipepstr(1)) Dim holdbytes() AsByte= Encoding.Unicode.GetBytes(HOLDOK & username) ClientSocket.SendTo(holdbytes, holdEP) Console.WriteLine("回送打洞消息.") End Sub ''''处理用户上线的函数 PrivateSub addOnLine()Sub addOnLine(ByVal inData() AsByte, ByVal recvCount AsInteger) DiminStrAsString= Encoding.Unicode.GetString(inData, 4, recvCount -4) Dim userinfo() AsString=inStr.Split("|") Dim strUserEP() AsString= userinfo(1).Split(":") Dim i AsInteger For i =0To 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 EndIf Next ReDimPreserve OLUserName(i +1) ReDimPreserve 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 ''''处理用户下线的函数 PrivateSub removeOnLine()Sub removeOnLine(ByVal inData() AsByte, ByVal recvCount AsInteger) Dim offUname AsString= Encoding.Unicode.GetString(inData, 4, recvCount -4) Dim i AsInteger For i =0To 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 EndIf Next End Sub ''''发送消息的函数 PublicFunction sendmsg()Function sendmsg(ByVal msg AsString, ByVal sendToIPEP As IPEndPoint) AsString Dim sendBytes As [Byte]() = Encoding.Unicode.GetBytes(msg) ''''判断发送的字节数是否超过了服务器缓冲区大小 If sendBytes.Length >1024Then Return"W输入的字数太多" EndIf ''''判断消息是否发送成功 While msgSendEnd =False sendDone =New ManualResetEvent(False) Try ClientSocket.SendTo(sendBytes, sendToIPEP) sendDone.WaitOne(10000, True) ''''阻塞线程10秒 If msgSendEnd =FalseThen Console.WriteLine("消息发送超时") Else ExitWhile EndIf Catch e As Exception Console.WriteLine("发送消息失败"& e.ToString) Exit Function EndTry Console.Write("是否重试?按Y重试,按任意键退出:") Dim userInput AsString= Console.ReadLine.ToUpper If userInput ="Y"Then Else msgSendEnd =False Exit Function EndIf EndWhile msgSendEnd =False End Function ''''用保持在线状态的函数 PrivateSub holdonline()Sub holdonline(ByVal state As [Object]) ClientSocket.SendTo(holdBytes, ServerEP) End Sub #End Region End Module