2016年4月6日 星期三

VB.net實現的一個簡單的P2P示例

這是用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 reccount 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

沒有留言:

張貼留言