游戏大厅 从基础开始（3.5）
——最吸引眼球的部分 客户端与服务器的连接 的实现
可能要犯大忌讳 本次只有代码 所以补充两句
正在实现策略模式的constructor 所以最近没有时间整理注释
大家凑合看 随后补说明
CodeNamespace Communicate.TCP
Class TCPLinkListener
Inherits Global.WayneGameSolution.Communicate.LinkListener
Public Shared ReadOnly propertyKeys As String() = {"Port", "TimeoutSecond", "LinkProveString"}
Public TCPListener As System.Net.Sockets.TcpListener
Private ClientLinkProvePool As New LinkedList(Of IClientLink)
Sub New(ByVal Parms As XElement)
MyBase.new(Parms)
Dim p As Int32
'todo: 各种本地化资源
Dim NotAvailableProperties As IEnumerable(Of String) = From key As String In propertyKeys Select key Where Not _ParmsDic.ContainsKey(key)
If NotAvailableProperties.Count > 0 Then
Throw New CommunicateException(String.Format(My.Resources.Communicate_TCPLinkListener_Parms_Error_Message, String.Join(",", propertyKeys), propertyKeys.Length, String.Join(",", NotAvailableProperties.ToArray())))
End If
If Port = -1 Then
Throw New CommunicateException((My.Resources.Communicate_TCPLinkListener_Parms_Port_Error_Message))
End If
If Not Int32.TryParse(Port, p) Then
Throw New CommunicateException("no int port")
End If
TCPListener = New System.Net.Sockets.TcpListener(Net.IPAddress.Any, p)
TCPListener.Start()
TCPListener.BeginAcceptSocket(AddressOf TCPListener_AcceptSocket, TCPListener)
End Sub
Sub TCPListener_AcceptSocket(ByVal o As IAsyncResult)
CheckTimeoutedLinks()
Dim socket As System.Net.Sockets.Socket = TCPListener.EndAcceptSocket(o)
Dim clk As New TCPClientLink(socket, TimeoutSecond, LinkProveString)
ClientLinkProvePool.AddLast(clk)
TCPListener.BeginAcceptSocket(AddressOf TCPListener_AcceptSocket, TCPListener)
End Sub
Private Sub CheckTimeoutedLinks()
Dim lk As TCPClientLink
Do While ClientLinkProvePool.Count > 0
lk = ClientLinkProvePool.First().Value
If lk.LastDataTime.AddSeconds(TimeoutSecond) < Now Then
ClientLinkProvePool.RemoveFirst()
If Not lk.IsLinkProved Then
lk.Close()
End If
Else
Exit Do
End If
Loop
End Sub
ReadOnly Property Port() As Int32
Get
Dim p As Int32
If Int32.TryParse(ParmsDic("Port"), p) Then
Return p
Else
Return -1
End If
End Get
End Property
ReadOnly Property TimeoutSecond() As Int32
Get
Dim t As Int32
If Int32.TryParse(ParmsDic("TimeoutSecond"), t) Then
Return t
Else
Return -1
End If
End Get
End Property
ReadOnly Property LinkProveString() As String
Get
Return ParmsDic("LinkProveString")
End Get
End Property
End Class
End Namespace
实现的功能 listen 连接 并且把30秒没有被验证/没有发送数据 的连接取消掉
好象smtp/ftp 这样的协议 如果连接开始几个byte不是期待的值 那么这就不是有效连接
所以用 ProveString 来设定这个开头 一个字节出错马上断开连接
CodeNamespace Communicate.TCP
Public Class TCPClientLink
Inherits ClientLink
Protected _Socket As Net.Sockets.Socket
ReadOnly Property Socket() As Net.Sockets.Socket
Get
Return _Socket
End Get
End Property
Public Overrides Sub Close()
If Me.Status = ILink.LinkStatus.Disconnected Then
Exit Sub
Else
Me._Status = ILink.LinkStatus.Disconnected
If Not Me._User Is Nothing Then
_User.Logoff()
End If
If _Socket.Connected Then
_Socket.Close()
End If
End If
End Sub
Protected InputCache As New IO.MemoryStream
Protected InputWriter As New IO.BinaryWriter(InputCache)
Protected InputReader As New IO.BinaryReader(InputCache)
Sub New(ByVal socket As Net.Sockets.Socket, ByVal timeout As Integer, ByVal LinkProveString As String)
_Socket = socket
_Status = ILink.LinkStatus.Ready
_TimeoutSecond = timeout
_LinkProveString = Text.Encoding.UTF8.GetBytes(LinkProveString)
Dim b(1023) As Byte
_Socket.BeginReceive(b, 0, b.Length, Net.Sockets.SocketFlags.None, AddressOf Socket_Receive, b)
End Sub
Protected _LinkProveString As Byte()
Sub Socket_Receive(ByVal o As IAsyncResult)
If Not _Socket.Connected Then
Me.Close()
Exit Sub
End If
If IsLinkProved Then Me._LastDataTime = Now
Dim b As Byte() = o.AsyncState
Dim length As Int32
length = _Socket.EndReceive(o)
If length = 0 Then
Close()
Else
InputWriter.Seek(0, IO.SeekOrigin.End)
InputWriter.Write(b, 0, length)
If Me._IsLinkProved Then
If InputCache.Length >= 8 Then MemeryStream_TryBuildPack()
Else
MemeryStream_TryProveLink()
End If
If _Socket.Connected Then _Socket.BeginReceive(b, 0, b.Length, Net.Sockets.SocketFlags.None, AddressOf Socket_Receive, b)
End If
End Sub
Private Sub MemeryStream_TryProveLink()
InputCache.Seek(0, IO.SeekOrigin.Begin)
Dim tmpb As Byte()
tmpb = InputReader.ReadBytes(_LinkProveString.Length)
For i As Int32 = 0 To _LinkProveString.Length - 1
If i = InputCache.Length Then Exit Sub
If tmpb(i) <> _LinkProveString(i) Then
Me.Close()
Exit Sub
End If
Next
Me._IsLinkProved = True
MemeryStream_DetachCache(tmpb.Length)
End Sub
Private Sub MemeryStream_DetachCache(ByVal length As Int32)
Dim ms As New IO.MemoryStream()
Me.InputWriter = New IO.BinaryWriter(ms)
Me.InputWriter.Write(Me.InputReader.ReadBytes(InputCache.Length - length))
Me.InputCache.Close()
InputCache.Dispose()
Me.InputCache = ms
Me.InputReader = New IO.BinaryReader(ms)
End Sub
Private Sub MemeryStream_TryBuildPack()
InputWriter.Seek(0, IO.SeekOrigin.Begin)
'包格式：总长度 as int32 (4)/flag as int32(4)/内容 as Bytes
Dim length As Int32 = InputReader.ReadInt32
If InputCache.Length >= length Then
Dim lp As LinkPack
If Me.Cryptography Is Nothing Then
Dim tp As New WayneGameSolution.Packs.pack_Basic_InitConnection_Up(Me.InputReader.ReadBytes(length))
If tp.Flag <> Packs.CommonPackFlag.Basic_InitConnection_Up Then
Me.Close()
End If
Me.Cryptography = Strategies.Strategy.Current.CreateObject(tp.CryptNamespace)
Me.PackCodec = Strategies.Strategy.Current.CreateObject(tp.CodecNamespace)
ElseIf _User Is Nothing Then
With Strategies.Strategy.Current.UserFactory
lp = Me.Cryptography.DeCrypt(New LinkPack(Me.InputReader.ReadBytes(length)))
Dim cp As Packs.ICommandPack = PackCodec.ToWorkingPack(lp)
If cp Is GetType(Packs.pack_Membership_Login_Up) Then
Dim lgp As Packs.pack_Membership_Login_Up = cp
Dim u As Membership.IUser
u = .LoginUser(Me, lgp.UID, lgp.Password)
ElseIf cp Is GetType(Packs.pack_Membership_SignIn_Up) Then
Dim lgp As Packs.pack_Membership_Login_Up = cp
Dim u As Membership.IUser
u = .CreateNewUser(Me, lgp.UID, lgp.Password)
End If
End With
Else
lp = Me.Cryptography.DeCrypt(New LinkPack(Me.InputReader.ReadBytes(length)))
Dim cp As Packs.ICommandPack = PackCodec.ToWorkingPack(lp)
cp.FromUser = _User
Me.Inbox.AddLast(cp)
End If
MemeryStream_DetachCache(length)
End If
End Sub
Sub TCPClient_Send(ByVal o As IAsyncResult)
Dim r As Net.Sockets.SocketError
Socket.EndSend(o, r)
If r <> Net.Sockets.SocketError.Success Then
Close()
Exit Sub
End If
If IsLinkProved Then Me._LastDataTime = Now
If Me.Outbox.Count = 0 Then
Status = IIf(Status = ILink.LinkStatus.Busy, ILink.LinkStatus.Ready, Status)
Else
Dim p As Packs.IWorkingPack = Outbox.First.Value
Outbox.RemoveFirst()
Dim b As Byte() = Cryptography.EnCrypt(PackCodec.ToLinkPack(Outbox.First.Value))
Socket.BeginSend(b, 0, b.Length, Net.Sockets.SocketFlags.None, AddressOf TCPClient_Send, Nothing)
End If
End Sub
Public Overrides Function ReceivePack() As Packs.IWorkingPack
If Me.Inbox.Count > 0 Then
SyncLock Inbox
Dim p As Packs.ICommandPack = Inbox.First.Value
Inbox.RemoveFirst()
Return p
End SyncLock
Else
Return Nothing
End If
End Function
Public Overrides Sub SendPack(ByVal ParamArray packs() As Packs.IWorkingPack)
For Each p As Packs.IWorkingPack In packs
Outbox.AddLast(p)
Next
If Status = ILink.LinkStatus.Ready Then
Status = ILink.LinkStatus.Busy
Dim p As ILinkPack = Outbox.First.Value
Outbox.RemoveFirst()
Dim b As Byte() = p.BinaryData
Socket.BeginSend(b, 0, b.Length, Net.Sockets.SocketFlags.None, AddressOf TCPClient_Send, Nothing)
End If
End Sub
End Class
End Namespace
收发都采用异步,尽可能把线程松散的让出来
下一次(4) 讲讲最近用config.xml 反射组件的的心得