- 浏览: 1159546 次
- 性别:
- 来自: nibiru
文章分类
- 全部博客 (407)
- lucene (1)
- java (147)
- j2se (1)
- javascript (2)
- spring (5)
- hibernate (1)
- mysql (1)
- oracle (10)
- 工作 (10)
- JPA (13)
- 网站 (5)
- xml (2)
- mina (3)
- 思想 (16)
- httpclient (10)
- JFreeChart (1)
- 多线程 (0)
- swing (2)
- socket (0)
- 网络 (3)
- protocol buffer (0)
- jmx (2)
- jboss/weblogic (1)
- flex3 (12)
- 设计模式 (1)
- apache (0)
- php (4)
- struts1&2 (2)
- oracle SOA (2)
- 微博短链接的生成算法(Java版本) (1)
- htmlparser (3)
- quartz (2)
- mail (1)
- 乱码 (2)
- txt (1)
- eclipse (7)
- 分类 (0)
- 数据库 (1)
- svn (1)
- 日志 (1)
- struts2 (4)
- jquery (2)
- 编码 (1)
- 路径,java (1)
- SOHO (1)
- 娱乐 (2)
- frameset (1)
- maven (1)
- 反射 (1)
- truts2 (1)
- 敏捷,scrum (1)
- OA (1)
- english (1)
- oralce (1)
- wampserver (1)
- 会计 (1)
- springmvc (1)
- js (1)
- CMA (1)
最新评论
-
ludabing:
[/color][color=yellow]
spring @component的作用 -
netwelfare:
EL表达式中null和empty的区别,可以看这篇文章:htt ...
EL表达式中empty的用法 -
wjs王结胜:
...
spring @component的作用 -
di1984HIT:
哈哈。真不错啊。~
微博短链接的生成算法(Java版本) -
di1984HIT:
不错,不错。。。
spring @component的作用
P2P的简单示例:VB.net版
这是用VB.net实现的一个简单的P2P示例.利用了UDP打洞技术.分服务器端跟客户端.服务器端负责登陆记录用户的IP和端口及转发打洞消息.(相关技术在CSDN搜一下.有很多的.).原理到处都有,这里就没有贴出来.这里贴出了VB.net的代码.供初学者交流.也欢迎高手点评...
服务器端在启动成功后.输入help可以查看到服务器相关命令.
客户端在登陆成功后.输入help可以查看客户端相关命令.(登陆时用户名随便.)
以下是服务器端:
ImportsSystem.Net
ImportsSystem.Net.Sockets
ImportsSystem.Text
ImportsSystem.Threading
ImportsSystem.Collections
ModulemyUDPServerModulemyUDPServer
全局变量#Region"全局变量"
DimServerSocketAsNewSocket(AddressFamily.InterNetwork,SocketType.Dgram,ProtocolType.Udp)
DimipepAsIPEndPoint=NewIPEndPoint(IPAddress.Any,11000)
DimhtUserListAsNewHashtable''''用来保存在线用户和用户的"IP和端口"
DimuserName(0)AsString
DimuserIPEP(0)AsIPEndPoint
DimuserTime(0)AsInteger
DimtimerDelegateAsNewTimerCallback(AddressOfonLineTimeOut)
#EndRegion
参数#Region"参数"
''''以下是客户端到服务器端的消息开头
ConstLOGININAsString="10"''''请求登陆的消息|||消息形式:10+自己的用户名
ConstLOGINOUTAsString="11"''''请求登出的消息|||消息形式:11+自己的用户名
ConstGETULISTAsString="12"''''请求获得在线用户列表|||消息形式:12
ConstP2PCONNAsString="13"''''请求P2P连接的消息|||消息形式:13+自己的用户名+|+对方的用户名
ConstHOLDLINEAsString="14"''''保持连接.|||消息开式:14+自己的用户名
''''以下是服务器到客户端的消息开头
ConstHVUSERAsString="20"''''用户名已存在
ConstGETUSERAsString="21"''''在线用户列表|||消息格式:21+用户名+EP
ConstMAKHOLDAsString="22"''''打洞命令|||消息格式:22+IP
ConstLOGINOKAsString="23"''''登陆成功
ConstSERVCLSAsString="24"''''服务器关闭
ConstMSGENDAsString="25"''''消息结束
''''以下是服务器端的命名
ConstEXITPROAsString="EXIT"''''退出命令
ConstSHOWULISTAsString="SHOWUSER"''''显示在线用户
ConstHELPAsString="HELP"''''显示帮助
#EndRegion
方法#Region"方法"
''''主函数,程序入口
SubMain()SubMain()
''''获得服务器的IP地址
DimaddressListAsSystem.Net.IPAddress()=Dns.GetHostByName(Dns.GetHostName()).AddressList
DimServerIPAsIPAddress=addressList(0)
ServerSocket.Bind(ipep)
Console.WriteLine("服务器正在启动....")
Console.WriteLine("服务器IP:"&ServerIP.ToString&"正在监听"&ipep.Port.ToString&"端口")
DimlistenTHAsNewThread(AddressOflisten)
listenTH.Start()''''启用监听的线程
Console.WriteLine("服务器启动成功.....")
DimtimerAsNewTimer(timerDelegate,Nothing,0,5000)
DimSVInputAsString
WhileTrue
Console.Write("Server>")
SVInput=Console.ReadLine().ToUpper
SelectCaseSVInput
CaseEXITPRO
listenTH.Abort()
ServerSocket.Close()
ExitSub
CaseSHOWULIST
showUser()
CaseHELP
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
EndSub
''''打印在线用户
SubshowUser()SubshowUser()
DimhavaAsBoolean=False
IfuserName.Length<>0Then
DimiAsInteger
Fori=1TouserName.Length-1
IfuserName(i)<>""Then
hava=True
ExitFor
EndIf
Next
Ifhava=FalseThen
Console.WriteLine("*********************************"&Chr(10)&Chr(13)&"当前没有用户在线"&Chr(10)&Chr(13)&"*********************************")
ExitSub
EndIf
Console.WriteLine("*********************************")
Fori=1TouserName.Length-1
IfuserName(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
EndSub
''''服务器监听函数
Sublisten()Sublisten()
WhileTrue
Try
DimrecvAsInteger=0
DimdataAs[Byte]()=NewByte(1024){}
DimsenderAsNewIPEndPoint(IPAddress.Any,0)
DimtempRemoteEPAsEndPoint=CType(sender,EndPoint)
recv=ServerSocket.ReceiveFrom(data,tempRemoteEP)
''''Console.WriteLine(Encoding.Unicode.GetString(data))
DimmsgHeadAsString=Encoding.Unicode.GetString(data,0,4)
SelectCasemsgHead
CaseLOGININ
DimLoginThingAsString=userLogin(data,tempRemoteEP,recv)
IfLoginThing=HVUSERThen
sendMsg(HVUSER,tempRemoteEP)
ElseIfLoginThing=LOGINOKThen
sendMsg(LOGINOK,tempRemoteEP)
EndIf
CaseLOGINOUT
userloginout(data,recv)
CaseGETULIST
DimuserinfoAsString=getUserList()
sendMsg(userinfo,tempRemoteEP)
CaseP2PCONN
questP2PConn(data,recv)
CaseHOLDLINE
holdOnLine(data,recv)
EndSelect
CatcheAsException
''''Console.WriteLine(e.ToString)
EndTry
EndWhile
EndSub
''''转发P2P连接请求
PrivateSubquestP2PConn()SubquestP2PConn(ByValdata()AsByte,ByValrecvAsInteger)
DimrecvStrAsString=Encoding.Unicode.GetString(data,4,recv-4)
Dimsplit()AsString=recvStr.Split("|")
DimfromEPAsIPEndPoint
DimtoEPAsIPEndPoint
DimiAsInteger
Fori=1TouserName.Length-1
IfuserName(i)=split(0)Then
fromEP=userIPEP(i)
EndIf
IfuserName(i)=split(1)Then
toEP=userIPEP(i)
EndIf
Next
Dimholdbytes()AsByte=Encoding.Unicode.GetBytes(MAKHOLD&fromEP.ToString)
ServerSocket.SendTo(holdbytes,toEP)
EndSub
''''函数.返回所有在线用户.其格式:用户名+|+用户IPEP+|
PrivateFunctiongetUserList()FunctiongetUserList()AsString
DimuserInfoAsString=GETUSER
DimiAsInteger
Fori=1TouserName.Length-1
IfuserName(i)<>""Then
userInfo+=userName(i)&"|"&userIPEP(i).ToString&"|"
EndIf
Next
ReturnuserInfo
EndFunction
''''用户登陆,直接返回登陆是否成功的值
PrivateFunctionuserLogin()FunctionuserLogin(ByValdataAsByte(),ByValuserEPAsIPEndPoint,ByValrecvCountAsInteger)AsString
DimUnameAsString=Encoding.Unicode.GetString(data,4,recvCount-4)
DimUinfobytes()AsByte
DimiAsInteger
DimjAsInteger
Fori=1TouserName.Length-1
IfUname=userName(i)Then
ReturnHVUSER
EndIf
Next
Fori=1TouserName.Length-1
IfuserName(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)
Forj=1TouserName.Length-1
IfuserName(j)<>""AnduserName(j)<>UnameThen
ServerSocket.SendTo(Uinfobytes,userIPEP(j))
EndIf
Next
ReturnLOGINOK
EndIf
Next
DimuserCountAsInteger=userName.Length
ReDimPreserveuserName(userCount)
ReDimPreserveuserIPEP(userCount)
ReDimPreserveuserTime(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)
Forj=1TouserName.Length-1
IfuserName(j)<>""AnduserName(j)<>UnameThen
ServerSocket.SendTo(Uinfobytes,userIPEP(j))
EndIf
Next
ReturnLOGINOK
EndFunction
''''用户登出
PrivateSubuserloginout()Subuserloginout(ByValdataAsByte(),ByValrecvCountAsInteger)
DimiAsInteger
DimUnameAsString=Encoding.Unicode.GetString(data,4,recvCount-4)
Fori=1TouserName.Length-1
IfUname=userName(i)Then
DimloginOutMsgAsString=LOGINOUT&userName(i)
userName(i)=""
userIPEP(i)=Nothing
userTime(i)=0
DimjAsInteger
Forj=1TouserName.Length-1
IfuserName(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
EndSub
''''保持用户在线的过程
PrivateSubholdOnLine()SubholdOnLine(ByValdataAsByte(),ByValrecvCountAsInteger)
DimUnameAsString=Encoding.Unicode.GetString(data,4,recvCount-4)
DimiAsInteger
Fori=1TouserName.Length-1
IfUname=userName(i)Then
userTime(i)=60
ExitFor
EndIf
Next
EndSub
''''用户超时退出
PrivateSubonLineTimeOut()SubonLineTimeOut(ByValstateAs[Object])
DimiAsInteger
Fori=1TouserName.Length-1
IfuserTime(i)>0Then
userTime(i)-=5
IfuserTime(i)<=0Then
DimloginoutmsgAsString=LOGINOUT&userName(i)
Console.WriteLine(Chr(10)&Chr(13)&"*********************************")
Console.WriteLine("用户"&userName(i)&"下线了.")
Console.WriteLine("*********************************")
Console.Write("Server>")
userName(i)=""
userIPEP(i)=Nothing
DimULoginOutbytes()AsByte=Encoding.Unicode.GetBytes(loginoutmsg)
DimjAsInteger
Forj=1TouserName.Length-1
IfuserName(j)<>""Then
IfuserIPEP(j)IsNothingThen
Else
ServerSocket.SendTo(ULoginOutbytes,userIPEP(j))
EndIf
EndIf
Next
EndIf
EndIf
Next
EndSub
''''发送消息的函数
SubsendMsg()SubsendMsg(ByValmsgAsString,ByValremoteEPAsIPEndPoint)
DimsendBytesAs[Byte]()=Encoding.Unicode.GetBytes(msg)
Try
ServerSocket.SendTo(sendBytes,remoteEP)
CatcheAsException
Console.WriteLine(e.ToString())
EndTry
EndSub
#EndRegion
EndModule
以下是客户端:
ImportsSystem.Net
ImportsSystem.Net.Sockets
ImportsSystem.Text
ImportsSystem.Threading
ModuleModule1ModuleModule1
参数#Region"参数"
''''以下是客户端到服务器端的消息开头
ConstLOGININAsString="10"''''请求登陆的消息|||消息形式:10+自己的用户名
ConstLOGINOUTAsString="11"''''请求登出的消息|||消息形式:11+自己的用户名
ConstGETULISTAsString="12"''''请求获得在线用户列表|||消息形式:12+自己的用户名
ConstP2PCONNAsString="13"''''请求P2P连接的消息|||消息形式:13+自己的用户名+对方的用户名
ConstHOLDLINEAsString="14"''''保持连接.|||消息开式:14+自己的用户名
''''以下是服务器到客户端的消息开头
ConstHVUSERAsString="20"''''用户名已存在
ConstGETUSERAsString="21"''''在线用户列表|||消息格式:21+用户名+EP
ConstMAKHOLDAsString="22"''''打洞命令|||消息格式:22+IP
ConstLOGINOKAsString="23"''''登陆成功
ConstSERVCLSAsString="24"''''服务器关闭
ConstMSGENDAsString="25"''''消息结束
''''以下是客户端到客户端的消息开头
ConstHOLDOKAsString="30"''''打洞成功
ConstCHATMSGAsString="31"''''聊天消息
ConstCHTMSGENDAsString="32"''''聊天消息发送成功
''''以下是客户端的命名
ConstEXITPROAsString="EXIT"''''退出命令
ConstSHOWULISTAsString="SHOWUSER"''''显示在线用户
ConstHELPAsString="HELP"''''显示帮助
ConstSENDAsString="SEND"''''发送消息
#EndRegion
全局全量#Region"全局全量"
DelegateSubmyMethodDelegate()SubmyMethodDelegate(ByRefmyInDataAsByte())''''登陆时用的事件
''''DimMaxTryAsInteger=5
DimmsgSendEndAsBoolean=False''''消息是否发送成功,若发送成功,则会返回结束消息
DimThListenAsNewThread(AddressOflisten)''''监听的线程
DimClientSocketAsNewSocket(AddressFamily.InterNetwork,SocketType.Dgram,ProtocolType.Udp)''''客户端套节字的定义
DimusernameAsString''''当前用户名
DimServerEPAsIPEndPoint''''服务器的IPEP
DimholdBytesAs[Byte]()=Encoding.Unicode.GetBytes(HOLDLINE&username)''''和服务器保持连接连接时用到的byte数组
DimOLUserName()AsString
DimOLUserEP()AsIPEndPoint
DimgetUrecCountAsInteger
DimtestHoldAsBoolean=False
DimtestChatAsBoolean=False
PrivatereceiveDoneAsManualResetEvent''''在登陆时用来阻塞线程,等待收到数据
PrivatesendDoneAsManualResetEvent''''用来阴塞发送消息的线程.等待收到回送的确认消息
PrivategetUDoneAsManualResetEvent''''用来阻塞请求好友名单的线程,等待接收好友名单
PrivateholdDoneAsManualResetEvent''''用来阻塞打洞时的线程
PrivatechatDoneAsManualResetEvent''''用来阻塞发送聊天消息时的线程
DimtimerDelegateAsNewTimerCallback(AddressOfholdonline)''''为保持在线状态弄得
#EndRegion
方法#Region"方法"
''''主函数,程序入口
SubMain()SubMain()
DimInputIPAsString
DimInputOKAsBoolean=False
''''判断输入的IP,并且保存服务器的IPEP
WhileInputOK<>True
Console.Write("请输入服务器IP:")
InputIP=Console.ReadLine()
Try
ServerEP=NewIPEndPoint(IPAddress.Parse(InputIP),11000)
InputOK=True
Catch
Console.WriteLine("你输入的服务器IP不正确,请重新输入.")
InputOK=False
EndTry
EndWhile
DimboolAsBoolean=False
''''判断用户是否登陆成功
Whilebool<>True
DimLoginOKAsBoolean=Login()
IfLoginOK=TrueThen
bool=True
Else
Console.Write("是否重试:输入Y重试,输入任意值退出程序:")
DimtempYNAsString=Console.ReadLine.ToUpper
IftempYN="Y"Then
bool=False
Else
ExitSub
EndIf
EndIf
EndWhile
Console.WriteLine("用户名:"&username)
holdBytes=Encoding.Unicode.GetBytes(HOLDLINE&username)
''''登陆成功后.用一个timer,每隔50秒向服务器发送消息,保持在线状态跟在主机注册的端口
DimtimerAsNewTimer(timerDelegate,Nothing,10000,50000)
''''请求在线名单
Console.WriteLine("正在获取在线名单,请稍后....")
DimgetUboolAsBoolean=False
WhilegetUbool<>True
getUbool=getU()
IfgetUbool=FalseThen
Console.Write("是否重试:输入Y重试,输入任意值退出程序:")
DimtempYNAsString=Console.ReadLine.ToUpper
IftempYN="Y"Then
bool=False
Else
ExitSub
EndIf
EndIf
EndWhile
ThListen.Start()
''''用来处理客户端的一些命令
DimSVInputAsString
WhileTrue
Console.Write("Client>")
SVInput=Console.ReadLine().ToUpper
SelectCaseSVInput
CaseEXITPRO
exitApp()
ThListen.Abort()
ClientSocket.Close()
ExitSub
CaseSHOWULIST
Console.WriteLine("*********************************")
showUserList()
Console.WriteLine("*********************************")
CaseHELP
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
IfSVInput.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
EndSub
''''登陆函数
PrivateFunctionLogin()FunctionLogin()AsBoolean
receiveDone=NewManualResetEvent(False)
DimuserBytesAs[Byte]()
DimuserOKAsBoolean=False
Console.Write("请输入你的用户名:")
''''判断用户名是否符合格式
While(userOK<>True)
username=Console.ReadLine.ToUpper
userBytes=Encoding.Unicode.GetBytes(LOGININ&username)
IfuserBytes.Length>24OruserBytes.Length<10Then
Console.WriteLine("用户名不得小于6个字节,且不得大于20个字节.")
Console.Write("请重新输入你的用户名:")
Else
userOK=True
EndIf
EndWhile
''''向服务器发送客户消息
ClientSocket.SendTo(userBytes,ServerEP)
DimdataAs[Byte]()=NewByte(1024){}
DimcomStrAsString=Encoding.Unicode.GetString(data,0,4)
''''异面的接收服务器回送的消息
DimDGrecvAsNewmyMethodDelegate(AddressOfrecvLogin)
DGrecv.BeginInvoke(data,Nothing,Nothing)
''''等待服务器回送消息的时长为10秒,否则为服务器超时
receiveDone.WaitOne(30000,True)
DimrecvStrAsString=Encoding.Unicode.GetString(data,0,4)
IfrecvStr=comStrThen
Console.WriteLine("服务器超时.登陆失败!!")
ReturnFalse
EndIf
IfEncoding.Unicode.GetString(data,0,4)=LOGINOKThen
Console.WriteLine("登陆成功!!")
ReturnTrue
ElseIfEncoding.Unicode.GetString(data,0,4)=HVUSERThen
Console.WriteLine("用户名重复.登陆失败!!")
ReturnFalse
Else
Console.WriteLine("服务器未知错误,登陆失败!!")
ReturnFalse
EndIf
EndFunction
''''登出函数
PrivateSubexitApp()SubexitApp()
DimloginOutStrAsString=LOGINOUT&username
DimsendBytesAs[Byte]()=Encoding.Unicode.GetBytes(loginOutStr)
ClientSocket.SendTo(sendBytes,ServerEP)
EndSub
''''请求好友列表的函数
PrivateFunctiongetU()FunctiongetU()AsBoolean
getUDone=NewManualResetEvent(False)
DimgetUbytesAsByte()=Encoding.Unicode.GetBytes(GETULIST)
ClientSocket.SendTo(getUbytes,ServerEP)
DimdataAs[Byte]()=NewByte(4056){}
DimcomStrAsString=Encoding.Unicode.GetString(data,0,4)
DimGUrecvAsNewmyMethodDelegate(AddressOfrecvGetU)
GUrecv.BeginInvoke(data,Nothing,Nothing)
getUDone.WaitOne(30000,True)
DimrecvStrAsString=Encoding.Unicode.GetString(data,0,4)
IfrecvStr=comStrThen
Console.WriteLine("服务器超时.或取好友名单失败!!")
ReturnFalse
EndIf
IfEncoding.Unicode.GetString(data,0,4)=GETUSERThen
getUserList(data,getUrecCount)
Console.WriteLine("获取在线名单成功!!")
showUserList()
ReturnTrue
Else
Console.WriteLine("服务器未知错误,获取在线名单失败!!")
ReturnFalse
EndIf
EndFunction
''''登陆时用来异步的接收服务器发送的消息
SubrecvLogin()SubrecvLogin(ByRefinDataAsByte())
ClientSocket.Receive(inData)
receiveDone.Set()
EndSub
''''请求好友名单时用来异步接收服务器发送的消息
SubrecvGetU()SubrecvGetU(ByRefinDataAsByte())
getUrecCount=ClientSocket.Receive(inData)
getUDone.Set()
EndSub
''''处理收到的在线用户信息
PrivateSubgetUserList()SubgetUserList(ByValuserInfobytes()AsByte,ByValreccountAsInteger)
DimustrAsString=Encoding.Unicode.GetString(userInfobytes,4,reccount-4)
DimsplitStr()AsString=Nothing
splitStr=Ustr.Split("|")
DimIPEPSplit()AsString=Nothing
DimiAsInteger=0
DimkAsInteger
Fork=0TosplitStr.Length-2Step2
ReDimPreserveOLUserName(i)
ReDimPreserveOLUserEP(i)
OLUserName(i)=splitStr(k)
IPEPSplit=splitStr(k+1).Split(":")
OLUserEP(i)=NewIPEndPoint(IPAddress.Parse(IPEPSplit(0)),IPEPSplit(1))
IPEPSplit=Nothing
i+=1
Next
EndSub
''''显示在线用户
PrivateSubshowUserList()SubshowUserList()
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)<>""Then
Console.WriteLine("用户名:"&OLUserName(i)&"用户IP:"&OLUserEP(i).ToString)
EndIf
Next
EndSub
''''客户程序监听的函数
Sublisten()Sublisten()
WhileTrue
Try
DimrecvAsInteger=0''''收到的字节数
DimdataAs[Byte]()=NewByte(1024){}''''缓冲区大小
DimsenderAsNewIPEndPoint(IPAddress.Any,0)
DimtempRemoteEPAsEndPoint=CType(sender,EndPoint)
recv=ClientSocket.ReceiveFrom(data,tempRemoteEP)
DimmsgHeadAsString=Encoding.Unicode.GetString(data,0,4)''''获得消息头的内容
SelectCasemsgHead
CaseMSGEND
msgSendEnd=True
sendDone.Set()
CaseLOGININ
addOnLine(data,recv)
CaseLOGINOUT
removeOnLine(data,recv)
CaseMSGEND
msgSendEnd=True
sendDone.Set()
CaseMAKHOLD
Console.WriteLine(Chr(10)&Chr(13)&"收到打洞消息.")
makeHold(data,recv)
Console.Write("Client>")
CaseCHATMSG
showChatMsg(data,recv)
CaseHOLDOK
testHold=True
holdDone.Set()
CaseCHTMSGEND
testChat=True
chatDone.Set()
EndSelect
Catch
EndTry
EndWhile
EndSub
''''发送聊天消息
PrivateSubsendChatMsg()SubsendChatMsg(ByValremoteUserAsString,ByValchatMsgStrAsString)
IfremoteUser=usernameThen
Console.WriteLine("猪头,你想干什么!!!")
ExitSub
EndIf
DimiAsInteger
DimremoteUEPAsIPEndPoint
Fori=0ToOLUserName.Length-1
IfremoteUser=OLUserName(i)Then
remoteUEP=OLUserEP(i)
ExitFor
EndIf
Ifi=OLUserName.Length-1Then
Console.WriteLine("找不到你想发送的用户.")
ExitSub
EndIf
Next
Dimmsgbytes()AsByte=Encoding.Unicode.GetBytes(CHATMSG&username&"|"&chatMsgStr)
Dimholdbytes()AsByte=Encoding.Unicode.GetBytes(P2PCONN&username&"|"&remoteUser)
chatDone=NewManualResetEvent(False)
ClientSocket.SendTo(msgbytes,remoteUEP)
chatDone.WaitOne(10000,True)
IftestChat=TrueThen
testChat=False
ExitSub
EndIf
testHold=False
WhiletestHold<>True
Console.WriteLine("打洞ing.....")
holdDone=NewManualResetEvent(False)
ClientSocket.SendTo(holdbytes,remoteUEP)
ClientSocket.SendTo(holdbytes,ServerEP)
holdDone.WaitOne(10000,True)
IftestHold=TrueThen
ExitWhile
Else
Console.WriteLine("打洞超时,发送消息失败.")
Console.Write("是否重试,按Y重试,按任意值结束发送:")
DimYorNAsString=Console.ReadLine().ToUpper
IfYorN="Y"Then
testHold=False
Else
ExitSub
EndIf
EndIf
EndWhile
WhiletestChat<>True
Console.WriteLine("打洞成功,正在准备发送.....")
chatDone=NewManualResetEvent(False)
ClientSocket.SendTo(msgbytes,remoteUEP)
chatDone.WaitOne(10000,True)
IftestChat=TrueThen
Console.WriteLine("消息发送成功!!")
ExitWhile
Else
Console.WriteLine("发送超时,发送消息失败.")
Console.Write("是否重试,按Y重试,按任意值结束发送:")
DimYorNAsString=Console.ReadLine().ToUpper
IfYorN="Y"Then
testChat=False
Else
ExitSub
EndIf
EndIf
EndWhile
testHold=False
testChat=False
EndSub
''''处理聊天消息
PrivateSubshowChatMsg()SubshowChatMsg(ByValindata()AsByte,ByValrecvcountAsInteger)
DimmsgStrAsString=Encoding.Unicode.GetString(indata,4,recvcount-4)
DimsplitStr()AsString=msgStr.Split("|")
DimfromUnameAsString=splitStr(0)
DimmsgAsString=splitStr(1)
Console.WriteLine(Chr(10)&Chr(13)&"收到来自"&fromUname&"的消息:"&msg)
Console.Write("Client>")
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)=fromUnameThen
ExitFor
EndIf
Next
Dimtempbytes()AsByte=Encoding.Unicode.GetBytes(CHTMSGEND)
ClientSocket.SendTo(tempbytes,OLUserEP(i))
EndSub
''''处理打洞函数
PrivateSubmakeHold()SubmakeHold(ByValindata()AsByte,ByValrecvcountAsInteger)
DimmakholdstrAsString=Encoding.Unicode.GetString(indata,4,recvcount)
Dimipepstr()AsString=makholdstr.Split(":")
DimholdEPAsIPEndPoint=NewIPEndPoint(IPAddress.Parse(ipepstr(0)),ipepstr(1))
Dimholdbytes()AsByte=Encoding.Unicode.GetBytes(HOLDOK&username)
ClientSocket.SendTo(holdbytes,holdEP)
Console.WriteLine("回送打洞消息.")
EndSub
''''处理用户上线的函数
PrivateSubaddOnLine()SubaddOnLine(ByValinData()AsByte,ByValrecvCountAsInteger)
DiminStrAsString=Encoding.Unicode.GetString(inData,4,recvCount-4)
Dimuserinfo()AsString=inStr.Split("|")
DimstrUserEP()AsString=userinfo(1).Split(":")
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)=""Then
OLUserName(i)=userinfo(0)
OLUserEP(i)=NewIPEndPoint(IPAddress.Parse(strUserEP(0)),strUserEP(1))
Console.WriteLine(Chr(10)&Chr(13)&"用户"&OLUserName(i)&"上线了.用户地址:"&OLUserEP(i).ToString)
Console.Write("Client>")
ExitSub
EndIf
Next
ReDimPreserveOLUserName(i+1)
ReDimPreserveOLUserEP(i+1)
OLUserName(i+1)=userinfo(0)
OLUserEP(i+1)=NewIPEndPoint(IPAddress.Parse(strUserEP(0)),strUserEP(1))
Console.WriteLine(Chr(10)&Chr(13)&"用户"&OLUserName(i+1)&"上线了.用户地址:"&OLUserEP(i+1).ToString)
Console.Write("Client>")
EndSub
''''处理用户下线的函数
PrivateSubremoveOnLine()SubremoveOnLine(ByValinData()AsByte,ByValrecvCountAsInteger)
DimoffUnameAsString=Encoding.Unicode.GetString(inData,4,recvCount-4)
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)=offUnameThen
OLUserName(i)=""
OLUserEP(i)=Nothing
Console.WriteLine(Chr(10)&Chr(13)&"用户"&offUname&"下线了.")
Console.Write("Client>")
ExitSub
EndIf
Next
EndSub
''''发送消息的函数
PublicFunctionsendmsg()Functionsendmsg(ByValmsgAsString,ByValsendToIPEPAsIPEndPoint)AsString
DimsendBytesAs[Byte]()=Encoding.Unicode.GetBytes(msg)
''''判断发送的字节数是否超过了服务器缓冲区大小
IfsendBytes.Length>1024Then
Return"W输入的字数太多"
EndIf
''''判断消息是否发送成功
WhilemsgSendEnd=False
sendDone=NewManualResetEvent(False)
Try
ClientSocket.SendTo(sendBytes,sendToIPEP)
sendDone.WaitOne(10000,True)''''阻塞线程10秒
IfmsgSendEnd=FalseThen
Console.WriteLine("消息发送超时")
Else
ExitWhile
EndIf
CatcheAsException
Console.WriteLine("发送消息失败"&e.ToString)
ExitFunction
EndTry
Console.Write("是否重试?按Y重试,按任意键退出:")
DimuserInputAsString=Console.ReadLine.ToUpper
IfuserInput="Y"Then
Else
msgSendEnd=False
ExitFunction
EndIf
EndWhile
msgSendEnd=False
EndFunction
''''用保持在线状态的函数
PrivateSubholdonline()Subholdonline(ByValstateAs[Object])
ClientSocket.SendTo(holdBytes,ServerEP)
EndSub
#EndRegion
EndModule
ImportsSystem.Net.Sockets
ImportsSystem.Text
ImportsSystem.Threading
ImportsSystem.Collections
ModulemyUDPServerModulemyUDPServer
全局变量#Region"全局变量"
DimServerSocketAsNewSocket(AddressFamily.InterNetwork,SocketType.Dgram,ProtocolType.Udp)
DimipepAsIPEndPoint=NewIPEndPoint(IPAddress.Any,11000)
DimhtUserListAsNewHashtable''''用来保存在线用户和用户的"IP和端口"
DimuserName(0)AsString
DimuserIPEP(0)AsIPEndPoint
DimuserTime(0)AsInteger
DimtimerDelegateAsNewTimerCallback(AddressOfonLineTimeOut)
#EndRegion
参数#Region"参数"
''''以下是客户端到服务器端的消息开头
ConstLOGININAsString="10"''''请求登陆的消息|||消息形式:10+自己的用户名
ConstLOGINOUTAsString="11"''''请求登出的消息|||消息形式:11+自己的用户名
ConstGETULISTAsString="12"''''请求获得在线用户列表|||消息形式:12
ConstP2PCONNAsString="13"''''请求P2P连接的消息|||消息形式:13+自己的用户名+|+对方的用户名
ConstHOLDLINEAsString="14"''''保持连接.|||消息开式:14+自己的用户名
''''以下是服务器到客户端的消息开头
ConstHVUSERAsString="20"''''用户名已存在
ConstGETUSERAsString="21"''''在线用户列表|||消息格式:21+用户名+EP
ConstMAKHOLDAsString="22"''''打洞命令|||消息格式:22+IP
ConstLOGINOKAsString="23"''''登陆成功
ConstSERVCLSAsString="24"''''服务器关闭
ConstMSGENDAsString="25"''''消息结束
''''以下是服务器端的命名
ConstEXITPROAsString="EXIT"''''退出命令
ConstSHOWULISTAsString="SHOWUSER"''''显示在线用户
ConstHELPAsString="HELP"''''显示帮助
#EndRegion
方法#Region"方法"
''''主函数,程序入口
SubMain()SubMain()
''''获得服务器的IP地址
DimaddressListAsSystem.Net.IPAddress()=Dns.GetHostByName(Dns.GetHostName()).AddressList
DimServerIPAsIPAddress=addressList(0)
ServerSocket.Bind(ipep)
Console.WriteLine("服务器正在启动....")
Console.WriteLine("服务器IP:"&ServerIP.ToString&"正在监听"&ipep.Port.ToString&"端口")
DimlistenTHAsNewThread(AddressOflisten)
listenTH.Start()''''启用监听的线程
Console.WriteLine("服务器启动成功.....")
DimtimerAsNewTimer(timerDelegate,Nothing,0,5000)
DimSVInputAsString
WhileTrue
Console.Write("Server>")
SVInput=Console.ReadLine().ToUpper
SelectCaseSVInput
CaseEXITPRO
listenTH.Abort()
ServerSocket.Close()
ExitSub
CaseSHOWULIST
showUser()
CaseHELP
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
EndSub
''''打印在线用户
SubshowUser()SubshowUser()
DimhavaAsBoolean=False
IfuserName.Length<>0Then
DimiAsInteger
Fori=1TouserName.Length-1
IfuserName(i)<>""Then
hava=True
ExitFor
EndIf
Next
Ifhava=FalseThen
Console.WriteLine("*********************************"&Chr(10)&Chr(13)&"当前没有用户在线"&Chr(10)&Chr(13)&"*********************************")
ExitSub
EndIf
Console.WriteLine("*********************************")
Fori=1TouserName.Length-1
IfuserName(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
EndSub
''''服务器监听函数
Sublisten()Sublisten()
WhileTrue
Try
DimrecvAsInteger=0
DimdataAs[Byte]()=NewByte(1024){}
DimsenderAsNewIPEndPoint(IPAddress.Any,0)
DimtempRemoteEPAsEndPoint=CType(sender,EndPoint)
recv=ServerSocket.ReceiveFrom(data,tempRemoteEP)
''''Console.WriteLine(Encoding.Unicode.GetString(data))
DimmsgHeadAsString=Encoding.Unicode.GetString(data,0,4)
SelectCasemsgHead
CaseLOGININ
DimLoginThingAsString=userLogin(data,tempRemoteEP,recv)
IfLoginThing=HVUSERThen
sendMsg(HVUSER,tempRemoteEP)
ElseIfLoginThing=LOGINOKThen
sendMsg(LOGINOK,tempRemoteEP)
EndIf
CaseLOGINOUT
userloginout(data,recv)
CaseGETULIST
DimuserinfoAsString=getUserList()
sendMsg(userinfo,tempRemoteEP)
CaseP2PCONN
questP2PConn(data,recv)
CaseHOLDLINE
holdOnLine(data,recv)
EndSelect
CatcheAsException
''''Console.WriteLine(e.ToString)
EndTry
EndWhile
EndSub
''''转发P2P连接请求
PrivateSubquestP2PConn()SubquestP2PConn(ByValdata()AsByte,ByValrecvAsInteger)
DimrecvStrAsString=Encoding.Unicode.GetString(data,4,recv-4)
Dimsplit()AsString=recvStr.Split("|")
DimfromEPAsIPEndPoint
DimtoEPAsIPEndPoint
DimiAsInteger
Fori=1TouserName.Length-1
IfuserName(i)=split(0)Then
fromEP=userIPEP(i)
EndIf
IfuserName(i)=split(1)Then
toEP=userIPEP(i)
EndIf
Next
Dimholdbytes()AsByte=Encoding.Unicode.GetBytes(MAKHOLD&fromEP.ToString)
ServerSocket.SendTo(holdbytes,toEP)
EndSub
''''函数.返回所有在线用户.其格式:用户名+|+用户IPEP+|
PrivateFunctiongetUserList()FunctiongetUserList()AsString
DimuserInfoAsString=GETUSER
DimiAsInteger
Fori=1TouserName.Length-1
IfuserName(i)<>""Then
userInfo+=userName(i)&"|"&userIPEP(i).ToString&"|"
EndIf
Next
ReturnuserInfo
EndFunction
''''用户登陆,直接返回登陆是否成功的值
PrivateFunctionuserLogin()FunctionuserLogin(ByValdataAsByte(),ByValuserEPAsIPEndPoint,ByValrecvCountAsInteger)AsString
DimUnameAsString=Encoding.Unicode.GetString(data,4,recvCount-4)
DimUinfobytes()AsByte
DimiAsInteger
DimjAsInteger
Fori=1TouserName.Length-1
IfUname=userName(i)Then
ReturnHVUSER
EndIf
Next
Fori=1TouserName.Length-1
IfuserName(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)
Forj=1TouserName.Length-1
IfuserName(j)<>""AnduserName(j)<>UnameThen
ServerSocket.SendTo(Uinfobytes,userIPEP(j))
EndIf
Next
ReturnLOGINOK
EndIf
Next
DimuserCountAsInteger=userName.Length
ReDimPreserveuserName(userCount)
ReDimPreserveuserIPEP(userCount)
ReDimPreserveuserTime(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)
Forj=1TouserName.Length-1
IfuserName(j)<>""AnduserName(j)<>UnameThen
ServerSocket.SendTo(Uinfobytes,userIPEP(j))
EndIf
Next
ReturnLOGINOK
EndFunction
''''用户登出
PrivateSubuserloginout()Subuserloginout(ByValdataAsByte(),ByValrecvCountAsInteger)
DimiAsInteger
DimUnameAsString=Encoding.Unicode.GetString(data,4,recvCount-4)
Fori=1TouserName.Length-1
IfUname=userName(i)Then
DimloginOutMsgAsString=LOGINOUT&userName(i)
userName(i)=""
userIPEP(i)=Nothing
userTime(i)=0
DimjAsInteger
Forj=1TouserName.Length-1
IfuserName(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
EndSub
''''保持用户在线的过程
PrivateSubholdOnLine()SubholdOnLine(ByValdataAsByte(),ByValrecvCountAsInteger)
DimUnameAsString=Encoding.Unicode.GetString(data,4,recvCount-4)
DimiAsInteger
Fori=1TouserName.Length-1
IfUname=userName(i)Then
userTime(i)=60
ExitFor
EndIf
Next
EndSub
''''用户超时退出
PrivateSubonLineTimeOut()SubonLineTimeOut(ByValstateAs[Object])
DimiAsInteger
Fori=1TouserName.Length-1
IfuserTime(i)>0Then
userTime(i)-=5
IfuserTime(i)<=0Then
DimloginoutmsgAsString=LOGINOUT&userName(i)
Console.WriteLine(Chr(10)&Chr(13)&"*********************************")
Console.WriteLine("用户"&userName(i)&"下线了.")
Console.WriteLine("*********************************")
Console.Write("Server>")
userName(i)=""
userIPEP(i)=Nothing
DimULoginOutbytes()AsByte=Encoding.Unicode.GetBytes(loginoutmsg)
DimjAsInteger
Forj=1TouserName.Length-1
IfuserName(j)<>""Then
IfuserIPEP(j)IsNothingThen
Else
ServerSocket.SendTo(ULoginOutbytes,userIPEP(j))
EndIf
EndIf
Next
EndIf
EndIf
Next
EndSub
''''发送消息的函数
SubsendMsg()SubsendMsg(ByValmsgAsString,ByValremoteEPAsIPEndPoint)
DimsendBytesAs[Byte]()=Encoding.Unicode.GetBytes(msg)
Try
ServerSocket.SendTo(sendBytes,remoteEP)
CatcheAsException
Console.WriteLine(e.ToString())
EndTry
EndSub
#EndRegion
EndModule
以下是客户端:
ImportsSystem.Net
ImportsSystem.Net.Sockets
ImportsSystem.Text
ImportsSystem.Threading
ModuleModule1ModuleModule1
参数#Region"参数"
''''以下是客户端到服务器端的消息开头
ConstLOGININAsString="10"''''请求登陆的消息|||消息形式:10+自己的用户名
ConstLOGINOUTAsString="11"''''请求登出的消息|||消息形式:11+自己的用户名
ConstGETULISTAsString="12"''''请求获得在线用户列表|||消息形式:12+自己的用户名
ConstP2PCONNAsString="13"''''请求P2P连接的消息|||消息形式:13+自己的用户名+对方的用户名
ConstHOLDLINEAsString="14"''''保持连接.|||消息开式:14+自己的用户名
''''以下是服务器到客户端的消息开头
ConstHVUSERAsString="20"''''用户名已存在
ConstGETUSERAsString="21"''''在线用户列表|||消息格式:21+用户名+EP
ConstMAKHOLDAsString="22"''''打洞命令|||消息格式:22+IP
ConstLOGINOKAsString="23"''''登陆成功
ConstSERVCLSAsString="24"''''服务器关闭
ConstMSGENDAsString="25"''''消息结束
''''以下是客户端到客户端的消息开头
ConstHOLDOKAsString="30"''''打洞成功
ConstCHATMSGAsString="31"''''聊天消息
ConstCHTMSGENDAsString="32"''''聊天消息发送成功
''''以下是客户端的命名
ConstEXITPROAsString="EXIT"''''退出命令
ConstSHOWULISTAsString="SHOWUSER"''''显示在线用户
ConstHELPAsString="HELP"''''显示帮助
ConstSENDAsString="SEND"''''发送消息
#EndRegion
全局全量#Region"全局全量"
DelegateSubmyMethodDelegate()SubmyMethodDelegate(ByRefmyInDataAsByte())''''登陆时用的事件
''''DimMaxTryAsInteger=5
DimmsgSendEndAsBoolean=False''''消息是否发送成功,若发送成功,则会返回结束消息
DimThListenAsNewThread(AddressOflisten)''''监听的线程
DimClientSocketAsNewSocket(AddressFamily.InterNetwork,SocketType.Dgram,ProtocolType.Udp)''''客户端套节字的定义
DimusernameAsString''''当前用户名
DimServerEPAsIPEndPoint''''服务器的IPEP
DimholdBytesAs[Byte]()=Encoding.Unicode.GetBytes(HOLDLINE&username)''''和服务器保持连接连接时用到的byte数组
DimOLUserName()AsString
DimOLUserEP()AsIPEndPoint
DimgetUrecCountAsInteger
DimtestHoldAsBoolean=False
DimtestChatAsBoolean=False
PrivatereceiveDoneAsManualResetEvent''''在登陆时用来阻塞线程,等待收到数据
PrivatesendDoneAsManualResetEvent''''用来阴塞发送消息的线程.等待收到回送的确认消息
PrivategetUDoneAsManualResetEvent''''用来阻塞请求好友名单的线程,等待接收好友名单
PrivateholdDoneAsManualResetEvent''''用来阻塞打洞时的线程
PrivatechatDoneAsManualResetEvent''''用来阻塞发送聊天消息时的线程
DimtimerDelegateAsNewTimerCallback(AddressOfholdonline)''''为保持在线状态弄得
#EndRegion
方法#Region"方法"
''''主函数,程序入口
SubMain()SubMain()
DimInputIPAsString
DimInputOKAsBoolean=False
''''判断输入的IP,并且保存服务器的IPEP
WhileInputOK<>True
Console.Write("请输入服务器IP:")
InputIP=Console.ReadLine()
Try
ServerEP=NewIPEndPoint(IPAddress.Parse(InputIP),11000)
InputOK=True
Catch
Console.WriteLine("你输入的服务器IP不正确,请重新输入.")
InputOK=False
EndTry
EndWhile
DimboolAsBoolean=False
''''判断用户是否登陆成功
Whilebool<>True
DimLoginOKAsBoolean=Login()
IfLoginOK=TrueThen
bool=True
Else
Console.Write("是否重试:输入Y重试,输入任意值退出程序:")
DimtempYNAsString=Console.ReadLine.ToUpper
IftempYN="Y"Then
bool=False
Else
ExitSub
EndIf
EndIf
EndWhile
Console.WriteLine("用户名:"&username)
holdBytes=Encoding.Unicode.GetBytes(HOLDLINE&username)
''''登陆成功后.用一个timer,每隔50秒向服务器发送消息,保持在线状态跟在主机注册的端口
DimtimerAsNewTimer(timerDelegate,Nothing,10000,50000)
''''请求在线名单
Console.WriteLine("正在获取在线名单,请稍后....")
DimgetUboolAsBoolean=False
WhilegetUbool<>True
getUbool=getU()
IfgetUbool=FalseThen
Console.Write("是否重试:输入Y重试,输入任意值退出程序:")
DimtempYNAsString=Console.ReadLine.ToUpper
IftempYN="Y"Then
bool=False
Else
ExitSub
EndIf
EndIf
EndWhile
ThListen.Start()
''''用来处理客户端的一些命令
DimSVInputAsString
WhileTrue
Console.Write("Client>")
SVInput=Console.ReadLine().ToUpper
SelectCaseSVInput
CaseEXITPRO
exitApp()
ThListen.Abort()
ClientSocket.Close()
ExitSub
CaseSHOWULIST
Console.WriteLine("*********************************")
showUserList()
Console.WriteLine("*********************************")
CaseHELP
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
IfSVInput.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
EndSub
''''登陆函数
PrivateFunctionLogin()FunctionLogin()AsBoolean
receiveDone=NewManualResetEvent(False)
DimuserBytesAs[Byte]()
DimuserOKAsBoolean=False
Console.Write("请输入你的用户名:")
''''判断用户名是否符合格式
While(userOK<>True)
username=Console.ReadLine.ToUpper
userBytes=Encoding.Unicode.GetBytes(LOGININ&username)
IfuserBytes.Length>24OruserBytes.Length<10Then
Console.WriteLine("用户名不得小于6个字节,且不得大于20个字节.")
Console.Write("请重新输入你的用户名:")
Else
userOK=True
EndIf
EndWhile
''''向服务器发送客户消息
ClientSocket.SendTo(userBytes,ServerEP)
DimdataAs[Byte]()=NewByte(1024){}
DimcomStrAsString=Encoding.Unicode.GetString(data,0,4)
''''异面的接收服务器回送的消息
DimDGrecvAsNewmyMethodDelegate(AddressOfrecvLogin)
DGrecv.BeginInvoke(data,Nothing,Nothing)
''''等待服务器回送消息的时长为10秒,否则为服务器超时
receiveDone.WaitOne(30000,True)
DimrecvStrAsString=Encoding.Unicode.GetString(data,0,4)
IfrecvStr=comStrThen
Console.WriteLine("服务器超时.登陆失败!!")
ReturnFalse
EndIf
IfEncoding.Unicode.GetString(data,0,4)=LOGINOKThen
Console.WriteLine("登陆成功!!")
ReturnTrue
ElseIfEncoding.Unicode.GetString(data,0,4)=HVUSERThen
Console.WriteLine("用户名重复.登陆失败!!")
ReturnFalse
Else
Console.WriteLine("服务器未知错误,登陆失败!!")
ReturnFalse
EndIf
EndFunction
''''登出函数
PrivateSubexitApp()SubexitApp()
DimloginOutStrAsString=LOGINOUT&username
DimsendBytesAs[Byte]()=Encoding.Unicode.GetBytes(loginOutStr)
ClientSocket.SendTo(sendBytes,ServerEP)
EndSub
''''请求好友列表的函数
PrivateFunctiongetU()FunctiongetU()AsBoolean
getUDone=NewManualResetEvent(False)
DimgetUbytesAsByte()=Encoding.Unicode.GetBytes(GETULIST)
ClientSocket.SendTo(getUbytes,ServerEP)
DimdataAs[Byte]()=NewByte(4056){}
DimcomStrAsString=Encoding.Unicode.GetString(data,0,4)
DimGUrecvAsNewmyMethodDelegate(AddressOfrecvGetU)
GUrecv.BeginInvoke(data,Nothing,Nothing)
getUDone.WaitOne(30000,True)
DimrecvStrAsString=Encoding.Unicode.GetString(data,0,4)
IfrecvStr=comStrThen
Console.WriteLine("服务器超时.或取好友名单失败!!")
ReturnFalse
EndIf
IfEncoding.Unicode.GetString(data,0,4)=GETUSERThen
getUserList(data,getUrecCount)
Console.WriteLine("获取在线名单成功!!")
showUserList()
ReturnTrue
Else
Console.WriteLine("服务器未知错误,获取在线名单失败!!")
ReturnFalse
EndIf
EndFunction
''''登陆时用来异步的接收服务器发送的消息
SubrecvLogin()SubrecvLogin(ByRefinDataAsByte())
ClientSocket.Receive(inData)
receiveDone.Set()
EndSub
''''请求好友名单时用来异步接收服务器发送的消息
SubrecvGetU()SubrecvGetU(ByRefinDataAsByte())
getUrecCount=ClientSocket.Receive(inData)
getUDone.Set()
EndSub
''''处理收到的在线用户信息
PrivateSubgetUserList()SubgetUserList(ByValuserInfobytes()AsByte,ByValreccountAsInteger)
DimustrAsString=Encoding.Unicode.GetString(userInfobytes,4,reccount-4)
DimsplitStr()AsString=Nothing
splitStr=Ustr.Split("|")
DimIPEPSplit()AsString=Nothing
DimiAsInteger=0
DimkAsInteger
Fork=0TosplitStr.Length-2Step2
ReDimPreserveOLUserName(i)
ReDimPreserveOLUserEP(i)
OLUserName(i)=splitStr(k)
IPEPSplit=splitStr(k+1).Split(":")
OLUserEP(i)=NewIPEndPoint(IPAddress.Parse(IPEPSplit(0)),IPEPSplit(1))
IPEPSplit=Nothing
i+=1
Next
EndSub
''''显示在线用户
PrivateSubshowUserList()SubshowUserList()
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)<>""Then
Console.WriteLine("用户名:"&OLUserName(i)&"用户IP:"&OLUserEP(i).ToString)
EndIf
Next
EndSub
''''客户程序监听的函数
Sublisten()Sublisten()
WhileTrue
Try
DimrecvAsInteger=0''''收到的字节数
DimdataAs[Byte]()=NewByte(1024){}''''缓冲区大小
DimsenderAsNewIPEndPoint(IPAddress.Any,0)
DimtempRemoteEPAsEndPoint=CType(sender,EndPoint)
recv=ClientSocket.ReceiveFrom(data,tempRemoteEP)
DimmsgHeadAsString=Encoding.Unicode.GetString(data,0,4)''''获得消息头的内容
SelectCasemsgHead
CaseMSGEND
msgSendEnd=True
sendDone.Set()
CaseLOGININ
addOnLine(data,recv)
CaseLOGINOUT
removeOnLine(data,recv)
CaseMSGEND
msgSendEnd=True
sendDone.Set()
CaseMAKHOLD
Console.WriteLine(Chr(10)&Chr(13)&"收到打洞消息.")
makeHold(data,recv)
Console.Write("Client>")
CaseCHATMSG
showChatMsg(data,recv)
CaseHOLDOK
testHold=True
holdDone.Set()
CaseCHTMSGEND
testChat=True
chatDone.Set()
EndSelect
Catch
EndTry
EndWhile
EndSub
''''发送聊天消息
PrivateSubsendChatMsg()SubsendChatMsg(ByValremoteUserAsString,ByValchatMsgStrAsString)
IfremoteUser=usernameThen
Console.WriteLine("猪头,你想干什么!!!")
ExitSub
EndIf
DimiAsInteger
DimremoteUEPAsIPEndPoint
Fori=0ToOLUserName.Length-1
IfremoteUser=OLUserName(i)Then
remoteUEP=OLUserEP(i)
ExitFor
EndIf
Ifi=OLUserName.Length-1Then
Console.WriteLine("找不到你想发送的用户.")
ExitSub
EndIf
Next
Dimmsgbytes()AsByte=Encoding.Unicode.GetBytes(CHATMSG&username&"|"&chatMsgStr)
Dimholdbytes()AsByte=Encoding.Unicode.GetBytes(P2PCONN&username&"|"&remoteUser)
chatDone=NewManualResetEvent(False)
ClientSocket.SendTo(msgbytes,remoteUEP)
chatDone.WaitOne(10000,True)
IftestChat=TrueThen
testChat=False
ExitSub
EndIf
testHold=False
WhiletestHold<>True
Console.WriteLine("打洞ing.....")
holdDone=NewManualResetEvent(False)
ClientSocket.SendTo(holdbytes,remoteUEP)
ClientSocket.SendTo(holdbytes,ServerEP)
holdDone.WaitOne(10000,True)
IftestHold=TrueThen
ExitWhile
Else
Console.WriteLine("打洞超时,发送消息失败.")
Console.Write("是否重试,按Y重试,按任意值结束发送:")
DimYorNAsString=Console.ReadLine().ToUpper
IfYorN="Y"Then
testHold=False
Else
ExitSub
EndIf
EndIf
EndWhile
WhiletestChat<>True
Console.WriteLine("打洞成功,正在准备发送.....")
chatDone=NewManualResetEvent(False)
ClientSocket.SendTo(msgbytes,remoteUEP)
chatDone.WaitOne(10000,True)
IftestChat=TrueThen
Console.WriteLine("消息发送成功!!")
ExitWhile
Else
Console.WriteLine("发送超时,发送消息失败.")
Console.Write("是否重试,按Y重试,按任意值结束发送:")
DimYorNAsString=Console.ReadLine().ToUpper
IfYorN="Y"Then
testChat=False
Else
ExitSub
EndIf
EndIf
EndWhile
testHold=False
testChat=False
EndSub
''''处理聊天消息
PrivateSubshowChatMsg()SubshowChatMsg(ByValindata()AsByte,ByValrecvcountAsInteger)
DimmsgStrAsString=Encoding.Unicode.GetString(indata,4,recvcount-4)
DimsplitStr()AsString=msgStr.Split("|")
DimfromUnameAsString=splitStr(0)
DimmsgAsString=splitStr(1)
Console.WriteLine(Chr(10)&Chr(13)&"收到来自"&fromUname&"的消息:"&msg)
Console.Write("Client>")
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)=fromUnameThen
ExitFor
EndIf
Next
Dimtempbytes()AsByte=Encoding.Unicode.GetBytes(CHTMSGEND)
ClientSocket.SendTo(tempbytes,OLUserEP(i))
EndSub
''''处理打洞函数
PrivateSubmakeHold()SubmakeHold(ByValindata()AsByte,ByValrecvcountAsInteger)
DimmakholdstrAsString=Encoding.Unicode.GetString(indata,4,recvcount)
Dimipepstr()AsString=makholdstr.Split(":")
DimholdEPAsIPEndPoint=NewIPEndPoint(IPAddress.Parse(ipepstr(0)),ipepstr(1))
Dimholdbytes()AsByte=Encoding.Unicode.GetBytes(HOLDOK&username)
ClientSocket.SendTo(holdbytes,holdEP)
Console.WriteLine("回送打洞消息.")
EndSub
''''处理用户上线的函数
PrivateSubaddOnLine()SubaddOnLine(ByValinData()AsByte,ByValrecvCountAsInteger)
DiminStrAsString=Encoding.Unicode.GetString(inData,4,recvCount-4)
Dimuserinfo()AsString=inStr.Split("|")
DimstrUserEP()AsString=userinfo(1).Split(":")
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)=""Then
OLUserName(i)=userinfo(0)
OLUserEP(i)=NewIPEndPoint(IPAddress.Parse(strUserEP(0)),strUserEP(1))
Console.WriteLine(Chr(10)&Chr(13)&"用户"&OLUserName(i)&"上线了.用户地址:"&OLUserEP(i).ToString)
Console.Write("Client>")
ExitSub
EndIf
Next
ReDimPreserveOLUserName(i+1)
ReDimPreserveOLUserEP(i+1)
OLUserName(i+1)=userinfo(0)
OLUserEP(i+1)=NewIPEndPoint(IPAddress.Parse(strUserEP(0)),strUserEP(1))
Console.WriteLine(Chr(10)&Chr(13)&"用户"&OLUserName(i+1)&"上线了.用户地址:"&OLUserEP(i+1).ToString)
Console.Write("Client>")
EndSub
''''处理用户下线的函数
PrivateSubremoveOnLine()SubremoveOnLine(ByValinData()AsByte,ByValrecvCountAsInteger)
DimoffUnameAsString=Encoding.Unicode.GetString(inData,4,recvCount-4)
DimiAsInteger
Fori=0ToOLUserName.Length-1
IfOLUserName(i)=offUnameThen
OLUserName(i)=""
OLUserEP(i)=Nothing
Console.WriteLine(Chr(10)&Chr(13)&"用户"&offUname&"下线了.")
Console.Write("Client>")
ExitSub
EndIf
Next
EndSub
''''发送消息的函数
PublicFunctionsendmsg()Functionsendmsg(ByValmsgAsString,ByValsendToIPEPAsIPEndPoint)AsString
DimsendBytesAs[Byte]()=Encoding.Unicode.GetBytes(msg)
''''判断发送的字节数是否超过了服务器缓冲区大小
IfsendBytes.Length>1024Then
Return"W输入的字数太多"
EndIf
''''判断消息是否发送成功
WhilemsgSendEnd=False
sendDone=NewManualResetEvent(False)
Try
ClientSocket.SendTo(sendBytes,sendToIPEP)
sendDone.WaitOne(10000,True)''''阻塞线程10秒
IfmsgSendEnd=FalseThen
Console.WriteLine("消息发送超时")
Else
ExitWhile
EndIf
CatcheAsException
Console.WriteLine("发送消息失败"&e.ToString)
ExitFunction
EndTry
Console.Write("是否重试?按Y重试,按任意键退出:")
DimuserInputAsString=Console.ReadLine.ToUpper
IfuserInput="Y"Then
Else
msgSendEnd=False
ExitFunction
EndIf
EndWhile
msgSendEnd=False
EndFunction
''''用保持在线状态的函数
PrivateSubholdonline()Subholdonline(ByValstateAs[Object])
ClientSocket.SendTo(holdBytes,ServerEP)
EndSub
#EndRegion
EndModule
相关推荐
标题 "P2P的简单示例(VB.net版)...总之,创建一个简单的P2P示例需要深入理解网络编程、多线程、数据交换和错误处理等概念,并能熟练运用VB.NET的相关类库。实际项目中,还需要考虑性能优化、网络安全以及兼容性等问题。
本示例主要关注的是利用VB.NET实现TCP协议下的NAT穿透,这是一种在网络通信中非常重要的技术,特别是在P2P(点对点)通讯和远程控制场景下。 首先,TCP(Transmission Control Protocol)是互联网协议栈中的传输层...
书名: ASP.NET 3.5入门经典——涵盖C#和VB.NET(第5版) 丛书名: 作者: (荷兰) Imar Spaanjaars著 这是一本非常好的ASP.NET入门书籍。本书以建立一个实际的Web站点为主线,从最初的没有任何功能的简单站点开始,...
【VB2008 多文件内网传送程序】是一个基于TCP协议的文件传输软件,由VB.NET开发,适用于.NET框架。该程序设计简洁,具有良好的用户界面,支持多个窗口进行点对点的文件传输,使得在局域网内的文件共享变得更加方便...
描述中提到,作者发现VB6用于P2P穿透的实例非常稀缺,因此他创建了一个示例来帮助其他人理解这一过程。这里的关键点是,为了测试这个P2P系统,你需要三个网络参与:一个服务端和两个客户端,它们分别位于不同的网络...
"Silverlight"则说明这个类库是专为Silverlight开发环境设计的,可以与XAML、C#或VB.NET等语言无缝集成。"类库"表示这是一个可复用的代码集合,为开发者提供便利的功能模块。 【压缩包子文件的文件名称列表】 1. ...
标题“vbfileupload_visualbasic_”暗示了这是一个关于使用Visual Basic进行文件上传的教程或示例。在描述中提到的“两个VB点对点发送文件例子”,表明我们将探讨如何使用VB实现TCP/IP协议来实现实时文件传输,这...
开发者可以使用C#、VB.NET或其他.NET支持的语言来编写代码。在P2P聊天工具的上下文中,.NET框架提供了丰富的类库和API,支持网络通信、数据序列化、多线程等关键功能,便于构建这样的应用程序。 【内容概览】 1. *...
### VB.NET中的网络点对点传输技术:TCP通信详解 #### 概述 在计算机网络领域,点对点(P2P)传输是一种重要的数据交换方式,它允许两台或多台设备之间直接进行通信,无需通过中央服务器。在Visual Basic (VB) 开发...
描述中提到的“UDP穿透NAT的列子”,暗示了这个示例可能涉及P2P通信或端口映射技术,因为NAT通常会阻止来自外部网络的直接通信。在NAT环境下,两个内部网络的主机通过公共IP和端口进行通信时,需要一种机制来正确...
标题 "P2P_file_sharing_code.rar_Find Files_VB 文件共享_sharing files" 提供了我们讨论的关键点:这是一个基于VB(Visual Basic)编程语言实现的P2P(点对点)文件共享客户端,它的主要功能是让用户能够搜索并...
VB2005,全称Visual Basic .NET 2005,是微软公司推出的.NET框架下的编程语言版本,主要用于构建Windows桌面应用、Web应用以及移动应用等。本教程是针对初学者的入门资料,旨在帮助新手快速掌握VB2005的基础知识和...
这个项目可能是一个学习示例,也可能是一个小型的实际应用,用于在局域网内进行点对点通信。 描述中提到的“基于VB6.0,点对点聊天工具,局域网内可以使用的小程序”进一步细化了该程序的特点。VB6.0是微软推出的一...
6. **兼容性**:由于是.NET框架的一部分,这个库可以与各种.NET语言如C#、VB.NET、F#等无缝配合。 在使用BitTorrent.Net时,开发者需要注意以下几个关键概念: - **Tracker**:BitTorrent网络中的服务器,负责维护...
摘要:VB源码,数据库应用,窗口置顶,显示在最前面 VisualBasic6.0让窗体保持在其它窗体的最前面显示,不被遮挡,目前像一些P2P视频播放软件都广泛加入类似功能,期待与大家共勉,书中的实例,稍加修改,用的可自己...
开发者可能会在这里找到如何使用VB创建聊天应用、实现P2P通信或者集成第三方即时通信SDK的教程和示例。 综上所述,"msdn for vb"这个资源集合可能是VB开发者的一份宝贵财富,包含了一系列关于VB编程、API使用、即时...
VB.NET是微软开发的一种面向对象的编程语言,它允许开发者利用.NET框架来创建各种应用程序。这里的“Net API”很可能指的是Windows API(应用程序编程接口),它是操作系统提供的一组函数,供应用程序调用以执行各种...
以下是一个简单的VB代码示例,展示了如何调用WMI来获取MAC地址: ```vb Imports System.Management Public Class Form1 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click ...
这个“WebRTCDemo-master_android-studio”项目显然是一个基于Android Studio的WebRTC示例应用,用于演示如何在Android设备上实现P2P(对等网络)视频和音频通信。 1. **WebRTC基础**:WebRTC提供了音频、视频和...