CLASS TCP/IP LISTENER TRES SIMPLE ET MULTITHREAD DOTNET

Imports System.Threading

Public Class clsListener

	Private intPort As Integer
	Private intMaxThreads As Integer
	Private intActiveThreads As Integer
	Private bListening As Boolean
	Private intTimeOut As Integer
	Private tcpListener As System.Net.Sockets.TcpListener
	Private WithEvents tmrListener As System.Windows.Forms.Timer

	Public Sub New()
		intPort = 6042		 'A redéfinir
		intTimeOut = 3000
		intMaxThreads = 2
		tmrListener = New Windows.Forms.Timer()
		tmrListener.Enabled = False
		tmrListener.Interval = 100
	End Sub

	Public Property Listening() As Boolean
		Get
			Return bListening
		End Get
		Set(ByVal Value As Boolean)
			Dim ret As Boolean
			If Not (bListening) Then
				ret = Start_Listening()
			Else
				ret = Stop_Listening()
			End If
			If ret Then
				bListening = Not (bListening)
			End If
		End Set
	End Property
	Public Property Port() As Integer
		Get
			Return intPort
		End Get
		Set(ByVal Value As Integer)
			intPort = Value
		End Set
	End Property
	Public Property maxThreads() As Integer
		Get
			Return intMaxThreads
		End Get
		Set(ByVal Value As Integer)
			If Value > 0 Then
				intMaxThreads = Value
			End If
		End Set
	End Property
	Public Property TimeOut() As Integer
		Get
			Return intTimeOut
		End Get
		Set(ByVal Value As Integer)
			If Value > 0 Then
				intTimeOut = Value
			End If
		End Set
	End Property
	Public ReadOnly Property CurrentThreads() As Integer
		Get
			Return intActiveThreads
		End Get
	End Property

	Public Event PostMessage(ByVal dTimePosted As Date, ByVal strHost As String, ByVal rawMessage As String)

	Private Function Start_Listening() As Boolean
		Try
			If Not tcpListener Is Nothing Then
				tcpListener.Stop()				   'Normalement inutile (dans un premier temps)
			Else
				tcpListener = New Net.Sockets.TcpListener(intPort)
			End If
			tcpListener.Start()
			tmrListener.Enabled = True
		Catch e As Exception
			Console.WriteLine(e.ToString)
			Return False
		End Try
		Return True
	End Function
	Private Function Stop_Listening() As Boolean
		Try
			If Not tcpListener Is Nothing Then
				tcpListener.Stop()
			End If
			tcpListener = Nothing
		Catch e As Exception
			Console.WriteLine(e.ToString)
			Return False
		End Try
		Return True
	End Function

	Private Sub GettingRawMessage(ByVal strHost As String, ByVal strMessage As String)
		RaiseEvent PostMessage(Now(), strHost, strMessage)
	End Sub

	Private Sub NewThread()
		intActiveThreads += 1
	End Sub
	Private Sub EndThread()
		intActiveThreads -= 1
	End Sub

	Private Sub tmrListener_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrListener.Tick

		Dim CurThreadStart As Threading.ThreadStart
		Dim CurThread As Threading.Thread
		Dim ThreadCount As Integer
		Dim i As Integer

		If Not (tcpListener.Pending()) Or (intActiveThreads >= intMaxThreads) Then
			Exit Sub
		End If

		tmrListener.Enabled = False

		Dim Connfollow As New clsFollowConn()
		Connfollow.tcpListener = tcpListener
		Connfollow.TimeOut = 5000

		AddHandler Connfollow.post_message, AddressOf GettingRawMessage
		AddHandler Connfollow.connect, AddressOf NewThread
		AddHandler Connfollow.disconnect, AddressOf EndThread

		CurThreadStart = New Threading.ThreadStart(AddressOf Connfollow.AcceptConnection)
		CurThread = New Threading.Thread(CurThreadStart)
		CurThread.Start()

		tmrListener.Enabled = True

	End Sub

End Class
Public Class clsFollowConn

	Private Declare Function GetTickCount Lib "kernel32" () As Integer
	Private intLastDataTime As Integer
	Private intTimeOut As Integer
	Private Const EoM = vbCrLf
	Public tcpListener As Net.Sockets.TcpListener

	Public Event disconnect()
	Public Event connect()
	Public Event post_message(ByVal host As String, ByVal message As String)

	Public Sub AcceptConnection()

		Dim CurThread As System.Threading.Thread
		Dim CurSocket As Net.Sockets.Socket

		Dim Buffer(1024) As Byte
		Dim Bytes As Integer
		Dim strTemp As String
		Dim bStop As Boolean

		RaiseEvent connect()
		CurThread = System.Threading.Thread.CurrentThread()
		CurSocket = tcpListener.AcceptSocket

		intLastDataTime = GetTickCount()

		While Not (bStop)
			If CurSocket.Available > 0 Then
				Bytes = CurSocket.Receive(Buffer, Buffer.Length, 0)
				If Bytes > 0 Then
					strTemp += System.Text.Encoding.Default.GetString(Buffer, 0, Bytes)
					split_msg(CType(CurSocket.RemoteEndPoint, Net.IPEndPoint).Address.ToString(), strTemp)
					intLastDataTime = GetTickCount()
				End If
			End If
			Application.DoEvents()

			If Not (CurSocket.Connected) Or ((GetTickCount() - intLastDataTime) > intTimeOut) Then
				CurSocket.Close()
				bStop = True
			End If
		End While
		RaiseEvent disconnect()
	End Sub
	Private Sub split_msg(ByVal strHost As String, ByRef strData As String)
		Dim lngPosLf, lngPosLast As Integer
		lngPosLast = 1
		lngPosLf = InStr(strData, EoM)
		While lngPosLf > 0
			RaiseEvent post_message(strHost, Mid$(strData, lngPosLast, lngPosLf - lngPosLast))
			lngPosLast = lngPosLf + Len(EoM)
			lngPosLf = InStr(lngPosLast, strData, EoM)
		End While
		strData = Right(strData, Len(strData) + 1 - lngPosLast)
	End Sub

	Public ReadOnly Property LastDataTime() As Integer
		Get
			Return intLastDataTime
		End Get
	End Property
	Public Property TimeOut() As Integer
		Get
			Return intTimeOut
		End Get
		Set(ByVal Value As Integer)
			intTimeOut = Value
		End Set
	End Property

End Class