Top / JUNK / TextTcp

TcpClient/TcpListener を使ったサンプルです。

Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading

Namespace Global.TextTcp

    Public Class TextTcpClient
        Implements IDisposable

        Private ReadOnly client As TcpClient
        Private ReadOnly reader As StreamReader
        Private ReadOnly writer As StreamWriter

        Public Sub New(tc As TcpClient)
            client = tc
            Dim st As Stream = tc.GetStream()
            reader = New StreamReader(st)
            writer = New StreamWriter(st)
            writer.AutoFlush = True
            Dim socket As Socket = tc.Client
            Key = socket.Handle
            RemoteEndPoint = socket.RemoteEndPoint
        End Sub

        Public ReadOnly Property Key As IntPtr
        Public ReadOnly Property RemoteEndPoint As EndPoint

        Public Function ReadLine() As String
            Return reader.ReadLine()
        End Function

        Public Sub WriteLine(message As String)
            Try
                writer.WriteLine(message)
            Catch ex As Exception

            End Try
        End Sub

        Public Sub ShutDown()
            client.Client.Shutdown(SocketShutdown.Send)
        End Sub

        Public Sub Close()
            client.Client.Close()
        End Sub

        Private disposedValue As Boolean = False

        Protected Overridable Sub Dispose(disposing As Boolean)
            If Not disposedValue Then
                disposedValue = True
                If disposing Then
                    reader?.Dispose()
                    writer?.Dispose()
                    client?.Dispose()
                End If
            End If
        End Sub

        Public Sub Dispose() Implements IDisposable.Dispose
            Dispose(True)
        End Sub

    End Class

    Public Class TextTcpClientCollection
        Implements IEnumerable(Of TextTcpClient)

        Private ReadOnly dic As New Dictionary(Of IntPtr, TextTcpClient)
        Private ReadOnly handle As New ManualResetEvent(True)

        Private ReadOnly Property SyncRoot As Object
            Get
                Return DirectCast(dic, ICollection).SyncRoot
            End Get
        End Property

        Public ReadOnly Property Count As Integer
            Get
                SyncLock SyncRoot
                    Return dic.Count
                End SyncLock
            End Get
        End Property

        Public Sub Add(tc As TextTcpClient)
            SyncLock SyncRoot
                If dic.Count = 0 Then
                    handle.Reset()
                End If
                dic.Add(tc.Key, tc)
            End SyncLock
        End Sub

        Public Sub Remove(tc As TextTcpClient)
            SyncLock SyncRoot
                dic.Remove(tc.Key)
                If dic.Count = 0 Then
                    handle.Set()
                End If
            End SyncLock
        End Sub

        Public Sub WaitOne()
            handle.WaitOne()
        End Sub

        Public Function GetEnumerator() As IEnumerator(Of TextTcpClient) Implements IEnumerable(Of TextTcpClient).GetEnumerator
            Dim array As New List(Of TextTcpClient)
            SyncLock SyncRoot
                array.AddRange(dic.Values.ToArray())
            End SyncLock
            Return array.GetEnumerator()
        End Function

        Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
            Return GetEnumerator()
        End Function

    End Class

    Public Class TextTcpEventArgs
        Inherits EventArgs

        Public Sub New(tc As TextTcpClient, readText As String)
            TextTcpClient = tc
            Text = readText
        End Sub

        Public ReadOnly Property TextTcpClient As TextTcpClient
        Public ReadOnly Property Text As String

    End Class

    Public Class TextTcpServer

        Private ReadOnly listener As TcpListener
        Private ReadOnly handle As New ManualResetEvent(False)

        Public ReadOnly Property Clients As New TextTcpClientCollection()

        Public Sub New(port As Integer)
            Me.New(IPAddress.Any, port)
        End Sub

        Public Sub New(localaddr As IPAddress, port As Integer)
            listener = New TcpListener(localaddr, port)
        End Sub

        Public Sub Start()
            listener.Start()
            BeginAccept()
            handle.Reset()
        End Sub

        Public Sub [Stop]()
            [Stop](False)
        End Sub

        Public Sub [Stop](force As Boolean)
            For Each tc As TextTcpClient In Clients
                If force Then
                    tc.Close()
                Else
                    tc.ShutDown()
                End If
            Next
            listener.Stop()
            Clients.WaitOne()
            handle.WaitOne()
        End Sub

        Private Shared Sub AcceptTcpClient(asyncResult As IAsyncResult)
            Dim ts As TextTcpServer = DirectCast(asyncResult.AsyncState, TextTcpServer)
            Using tc As TextTcpClient = ts.EndAccept(asyncResult)
                If tc Is Nothing Then
                    ts.handle.Set()
                Else
                    ts.BeginAccept()
                    ts.OnRecieve(tc)
                End If
            End Using
        End Sub

        Private Function BeginAccept() As IAsyncResult
            Return listener.BeginAcceptTcpClient(New AsyncCallback(AddressOf AcceptTcpClient), Me)
        End Function

        Private Function EndAccept(asyncResult As IAsyncResult) As TextTcpClient
            Try
                Dim tc As TcpClient = listener.EndAcceptTcpClient(asyncResult)
                Return New TextTcpClient(tc)
            Catch ex As Exception
                Return Nothing
            End Try
        End Function

        Private Sub OnRecieve(tc As TextTcpClient)
            Clients.Add(tc)
            OnAccept(New TextTcpEventArgs(tc, Nothing))
            Try
                Do
                    Dim text As String = tc.ReadLine()
                    If text Is Nothing Then Exit Do
                    OnRead(New TextTcpEventArgs(tc, text))
                Loop

            Catch ex As Exception
                Debug.Print(ex.ToString())
            End Try
            Clients.Remove(tc)
            OnClose(New TextTcpEventArgs(tc, Nothing))
        End Sub

        Public Event Read As EventHandler(Of TextTcpEventArgs)
        Public Event Accept As EventHandler(Of TextTcpEventArgs)
        Public Event Close As EventHandler(Of TextTcpEventArgs)

        Protected Overridable Sub OnAccept(e As TextTcpEventArgs)
            RaiseEvent Accept(Me, e)
        End Sub

        Protected Overridable Sub OnRead(e As TextTcpEventArgs)
            RaiseEvent Read(Me, e)
        End Sub

        Protected Overridable Sub OnClose(e As TextTcpEventArgs)
            RaiseEvent Close(Me, e)
        End Sub

        Public Sub SendAllClients(message As String)
            For Each tc As TextTcpClient In Clients
                tc.WriteLine(message)
            Next
        End Sub

    End Class

End Namespace

使い方

Imports TextTcp

Public Class Form1

    Private WithEvents Server As TextTcpServer

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Control.CheckForIllegalCrossThreadCalls = False
        SetButtons(True)
        Server = New TextTcpServer(4305)
        ShowClientCount()
    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        If Button2.Enabled Then
            Server.Stop(True)
        End If
    End Sub

    Private Sub SetButtons(ByVal enabled As Boolean)
        Button1.Enabled = enabled
        Button2.Enabled = Not enabled
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Server.Start()
        SetButtons(False)
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Server.Stop()
        SetButtons(True)
    End Sub

    Private Sub TextBox1_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyDown
        If e.KeyCode = Keys.Enter Then
            e.SuppressKeyPress = True
            If TextBox1.Text.Length > 0 Then
                Server.SendAllClients(TextBox1.Text)
                TextBox1.Clear()
            End If
        End If
    End Sub

    Private Sub Server_Read(sender As Object, e As TextTcpEventArgs) Handles Server.Read
        SyncLock ListView1
            Dim item As ListViewItem = ListView1.Items.Add(Now.ToString())
            item.SubItems.Add(e.TextTcpClient.RemoteEndPoint.ToString())
            item.SubItems.Add(e.Text)
            item.EnsureVisible()
        End SyncLock
    End Sub

    Private Sub ShowClientCount()
        Me.Text = String.Format("{0} 接続中", Server.Clients.Count)
    End Sub

    Private Sub Server_Accept(sender As Object, e As TextTcpEventArgs) Handles Server.Accept
        ShowClientCount()
    End Sub

    Private Sub Server_Close(sender As Object, e As TextTcpEventArgs) Handles Server.Close
        ShowClientCount()
    End Sub

End Class



トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   最終更新のRSS
Last-modified: 2020-02-20 (木) 11:32:23 (140d)