可能要犯大忌諱 本次只有代碼 所以補充兩句
正在實現策略模式的constructor 所以最 近沒有時間整理注釋
大家湊合看 隨後補說明
Code
Namespace 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 來設定這個開頭 一個字節出 錯馬上斷開連接
Code
Namespace 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 反射組件的的心得
