Projects

javaSpy

April 15, 2008 by Java

Browsing clsTcpServer.vb (6.21 KB)

Option Explicit On

Imports System.Net
Imports System.Net.Sockets
Imports System.Text.Encoding
Imports System.Threading

Public Class clsTcpServer

    Implements IDisposable

    Public Clients As New Collection
    Public MaxClients As Integer = 0

    Private thisSock As Socket = Nothing
    Private thisListener As TcpListener = Nothing
    Private thisThread As Thread = Nothing
    Private callbackNewClientSub As TcpServerNewClientSub = Nothing
    Private callbackDisconnectSub As TcpServerClientDisconnectSub = Nothing

    Public Delegate Sub TcpServerNewClientSub(ByVal newClient As clsTcpClient)
    Public Delegate Sub TcpServerClientDisconnectSub(ByVal thisClient As clsTcpClient)

    Public Const DefaultMaxClients As Integer = 0 ' no limit

    Private Const SOCKET_RECV_TIMEOUT = 2000 ' 2 seconds
    Private Const SOCKET_SEND_TIMEOUT = 2000 ' 2 seconds
    Private Const LOOP_SLEEP_DELAY = 10 ' 1/100 second

    Public Sub New(ByVal ip As String, ByVal port As Integer, _
        Optional ByVal max_clients As Integer = DefaultMaxClients, _
        Optional ByVal clientDisconnectCallback As TcpServerClientDisconnectSub = Nothing)

        Me.MaxClients = max_clients
        Me.callbackDisconnectSub = clientDisconnectCallback

        ' instantiate a new tcp socket
        thisSock = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)

        ' configure the socket
        thisSock.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReceiveTimeout, SOCKET_RECV_TIMEOUT)
        thisSock.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.SendTimeout, SOCKET_SEND_TIMEOUT)

        Dim hostEndpoint As IPEndPoint = Nothing

        If ip Is Nothing Then
            hostEndpoint = New IPEndPoint(IPAddress.Any, port)
        Else
            hostEndpoint = New IPEndPoint(IPAddress.Parse(ip), port)
        End If

        thisListener = New TcpListener(hostEndpoint)

    End Sub

    Public ReadOnly Property Ready() As Boolean
        Get
            Return Not (thisSock Is Nothing)
        End Get
    End Property

    Public ReadOnly Property IsListening() As Boolean
        Get
            Return Not (thisThread Is Nothing)
        End Get
    End Property

    Public Sub StartListener(ByVal newClientCallback As TcpServerNewClientSub)

        If thisThread Is Nothing Then

            callbackNewClientSub = newClientCallback
            thisListener.Start()

            thisThread = New Thread(AddressOf _threadedListener)
            thisThread.Priority = ThreadPriority.BelowNormal
            thisThread.IsBackground = True
            thisThread.Start(Me)

        End If

    End Sub

    Public Sub StopListener()

        If Not (thisThread Is Nothing) Then

            thisThread.Abort()
            thisThread = Nothing

            thisListener.Stop()

        End If

    End Sub

    Public Sub Dispose() Implements IDisposable.Dispose

        Do While Clients.Count > 0

            Dim thisTcpClient As clsTcpClient = Clients.Item(Clients.Count)
            Clients.Remove(thisTcpClient.ToString)
            thisTcpClient.Dispose()

        Loop

        StopListener()
        thisSock.Close()

    End Sub

    Public Sub _threadedListener(ByVal tcpObject As Object)

        Dim thisTcpServer As clsTcpServer = tcpObject

        Do Until Not thisTcpServer.IsListening

            ' check for pending connection
            If thisTcpServer.thisListener.Pending() Then

                ' check for max connections
                If thisTcpServer.MaxClients = 0 Or _
                    thisTcpServer.Clients.Count < thisTcpServer.MaxClients Then

                    Try

                        ' accept the incoming connection on a new thread
                        With New Thread(AddressOf _threadedAccept)
                            .IsBackground = True
                            .Priority = ThreadPriority.AboveNormal
                            .Start(thisTcpServer)
                        End With

                    Catch
                    End Try

                Else

                    Try

                        Dim thisSock As Socket = thisTcpServer.thisListener.AcceptSocket()
                        thisSock.Close()

                    Catch
                    End Try

                End If

            End If

            ' sleep for a duration of time
            Thread.Sleep(LOOP_SLEEP_DELAY)

        Loop

    End Sub

    Private Sub _threadedAccept(ByVal tcpObject As Object)

        Dim thisTcpServer As clsTcpServer = tcpObject
        Dim newClient As clsTcpClient = Nothing

        Try

            ' dummy object used for sync locking
            Dim objLock As New Object

            ' lock the object to this thread
            SyncLock objLock

                ' accept the incoming connection
                newClient = New clsTcpClient(thisTcpServer, thisTcpServer.thisListener.AcceptSocket(), _
                    New clsTcpClient.TcpClientDisconnectSub(AddressOf _clientDisconnectCallback))

            End SyncLock

            objLock = Nothing

            ' validate the new connection
            If Not (newClient Is Nothing) Then

                ' add the new client to the collection
                thisTcpServer.Clients.Add(newClient, newClient.ToString)

                ' raise new client callback func
                If Not (thisTcpServer.callbackNewClientSub Is Nothing) Then _
                    thisTcpServer.callbackNewClientSub.Invoke(newClient)

            End If

        Catch
        End Try

    End Sub

    Private Sub _clientDisconnectCallback(ByVal thisTcpClient As clsTcpClient)

        Dim thisTcpServer As clsTcpServer = thisTcpClient.TcpServer

        If Not (thisTcpServer Is Nothing) Then

            ' remove the disconnected client
            thisTcpServer.Clients.Remove(thisTcpClient.ToString)

            ' raise client disconnect callback
            If Not (thisTcpServer.callbackDisconnectSub Is Nothing) Then _
                thisTcpServer.callbackDisconnectSub.Invoke(thisTcpClient)

        End If

    End Sub

End Class

Download clsTcpServer.vb

Back to file list

---

Back to project page