Server Wrapper - BB_Server.vb
Imports RTS_Listener Imports System.Net ''' <summary> ''' This is the BB server, fill in properties for full effect ''' </summary> ''' <remarks></remarks> Public Class BB_Server Inherits Object Private WithEvents Server As New RTS_Listener #Region " Properties " Private esAdminUsername As String = "Admin" Public Property AdminUsername() As String Get Return esAdminUsername End Get Set(ByVal value As String) esAdminUsername = value End Set End Property Private esPort As Integer = 50000 Public Property Port() As Integer Get Return esPort End Get Set(ByVal value As Integer) esPort = value End Set End Property Private esLog As String = String.Empty Public ReadOnly Property Log() As String Get Return esLog End Get End Property Private esMaxConnections As Integer = 500 '(499 as zero counts as a connection) Public Property MaxConnections() As Integer Get Return esMaxConnections End Get Set(ByVal value As Integer) esMaxConnections = value End Set End Property Private esCurrentConnections As Integer = 0 Public ReadOnly Property CurrentConnections() As Integer Get Return esCurrentConnections End Get End Property Private esMaxMessageLength As Integer = 200 Public Property MaxMessagelength() As Integer Get Return esMaxMessageLength End Get Set(ByVal value As Integer) esMaxMessageLength = value End Set End Property Private esLogInToTalk As Boolean = True Public Property LogInToTalk() As Boolean Get Return esLogInToTalk End Get Set(ByVal value As Boolean) esLogInToTalk = value End Set End Property Private esServerStatus As _ServerStatus Public Property ServerStatus() As _ServerStatus Get Return esServerStatus End Get Set(ByVal value As _ServerStatus) esServerStatus = value End Set End Property #End Region #Region " Server Commands " ''' <summary> ''' Starts the server on the dedicated port defualt is, 50000 ''' </summary> ''' <remarks></remarks> Public Sub StartServer() Server.Listen(Port) ServerStatus = _ServerStatus.Running End Sub ''' <summary> ''' Stops and disposes of the current server ''' </summary> ''' <remarks></remarks> Public Sub StopServer() ServerStatus = _ServerStatus.Stopping Server.Broadcast(Contact.Shutdown) Server.Close() ServerStatus = _ServerStatus.Stoped End Sub ''' <summary> ''' Sends A message on behalf of you to all clients ''' </summary> ''' <param name="Message"></param> ''' <remarks></remarks> Public Sub SendMessage(ByVal Message As String) Server.Broadcast(Contact.Normal, AdminUsername & " : " & Message) End Sub ''' <summary> ''' Resets the events log ''' </summary> ''' <remarks></remarks> Public Sub ResetLog() esLog = String.Empty End Sub ''' <summary> ''' Return the entire log. (Or up till it was last cleared) ''' </summary> ''' <returns></returns> ''' <remarks></remarks> Public Function ReadLog() Return Log End Function Public Sub BootUser(ByVal Username As String) Server.BootUser(Username) End Sub #End Region #Region " Enums " Private Enum Contact As Byte Normal = 1 AdminMessage = 2 ServerMessage = 3 Shutdown = 4 Login = 5 LoginRejected = 6 End Enum Public Enum _ServerStatus Running = 1 Stoped = 2 Stopping = 3 End Enum #End Region #Region " Server Defiened Events " Private Sub Server_ClientLoggedIn(ByVal Username As String) Handles Server.ClientLoggedIn RaiseEvent OnUserLoggedIn(Username) Server.Broadcast(Contact.Normal, Username & " has joined the chat.") End Sub ' We only need these three unless you want to fileshare, which may soon loose ' you your internet connection, PERNEMENTLY!!!!! Private Sub Server_ConnectionRequest(ByVal Requestor As System.Net.Sockets.TcpClient, ByRef AllowConnection As Boolean) Handles Server.ConnectionRequest ' to prevent a buffer overflow or a major blue screen because of lack ' of ram I introduced this fail safe system that will block all ' connections over the specified limit. If CurrentConnections >= MaxConnections Then AllowConnection = False Else AllowConnection = True RaiseEvent OnConnectionRequest() esCurrentConnections = esCurrentConnections + 1 End If End Sub Private Sub Server_Disconnect(ByVal Client As RTS_SocketClient) Handles Server.Disconnect ' We must remember to remove a connection or our server will get clogged! esCurrentConnections = esCurrentConnections - 1 If Client.Username = "" Then RaiseEvent OnClientDisconect() Else RaiseEvent OnUserDisconnect(Client.Username) End If Server.Broadcast(Contact.Normal, Client.Username & " has just left the chat.") End Sub Private Sub Server_MessageReceived(ByVal Client As RTS_SocketClient, ByVal message As Byte) Handles Server.MessageReceived RaiseEvent OnMessageRecived(message) End Sub Private Sub Server_StringReceived(ByVal Client As RTS_SocketClient, ByVal msgTag As Byte, ByVal message As String) Handles Server.StringReceived If msgTag = Contact.Normal Then If message.Count > MaxMessagelength Then Client.Send(Contact.ServerMessage, "Message must not be longer than " & MaxMessagelength & " characters. Yours was " & message.Count & " characters long.") Else Dim b As String = Server.ReturnUsername(Client) If Not b = "" Then Dim c As String = (b & ": " & message) Server.Broadcast(Contact.Normal, c) RaiseEvent OnMessageRecived(c) Else If LogInToTalk = False Then Dim c As String = (b & ": " & message) Server.Broadcast(Contact.Normal, c) RaiseEvent OnMessageRecived(c) Else Client.Send(Contact.ServerMessage, "You must login before you can talk.") End If End If End If ElseIf msgTag = Contact.Login Then If Server.ValidateLogin(message, AdminUsername, Client) = True Then Server.Login(Client, message) RaiseEvent OnUserLoggedIn(message) Server.Broadcast(Contact.Normal, message & " has joined the chat.") Else Client.Send(Contact.LoginRejected, "Your username was rejected.") End If Else ' We should only be getting messages with the normal tag, otherwise ' Our server may of been comprimised / someone has got a rouge app ' in the conversation. Exit Sub End If End Sub #End Region #Region " Events " Public Event OnConnectionRequest() Public Event OnClientDisconect() Public Event OnMessageRecived(ByVal Message As String) Public Event OnUserLoggedIn(ByVal Username As String) Public Event OnUserDisconnect(ByVal Username As String) #End Region End Class
This code is fairly simply, but it saves you having to type it out again.
Client - BB_Client.vb
''' <summary>
''' This is the BB client, fill in properties for full effect.
''' </summary>
''' <remarks></remarks>
Public Class BB_Client
Inherits Object
Private WithEvents Client As New RTS_SocketClient
#Region " Properties "
Private esPort As Integer = 50000
Public Property Port() As Integer
Get
Return esPort
End Get
Set(ByVal value As Integer)
esPort = value
End Set
End Property
Private esNickName As String = ""
Public Property NickName() As String
Get
Return esNickName
End Get
Set(ByVal value As String)
esNickName = value
End Set
End Property
Private esConnected As Boolean = False
Public ReadOnly Property Conncected() As Boolean
Get
Return esConnected
End Get
End Property
Private esConversationLog As String = ""
Public ReadOnly Property ConverstationLog() As String
Get
Return esConversationLog
End Get
End Property
#End Region
#Region " Enums "
Private Enum Contact As Byte
Normal = 1
AdminMessage = 2
ServerMessage = 3
Shutdown = 4
Login = 5
LoginRejected = 6
End Enum
#End Region
#Region " Public Code "
''' <summary>
''' Sends your message to the server, it will be rejected if it is too long.
''' </summary>
''' <param name="Message"></param>
''' <remarks></remarks>
Public Sub SendMessage(ByVal Message As String)
Try
Client.Send(Contact.Normal, Message)
Catch ex As Exception
RaiseEvent onerror(ex)
End Try
End Sub
''' <summary>
''' Connects you to a remote host
''' </summary>
''' <param name="IP"></param>
''' <remarks></remarks>
Public Sub Connect(ByVal IP As String)
Try
Client.ConnectToHost(IP, Port)
Catch ex As Exception
RaiseEvent onerror(ex)
End Try
End Sub
''' <summary>
''' Disconnect from your remote host.
''' </summary>
''' <remarks></remarks>
Public Sub Disconnect()
Try
Client.DisconnectFromHost()
Catch ex As Exception
RaiseEvent onerror(ex)
End Try
End Sub
''' <summary>
''' Loggs a Username.
''' </summary>
''' <param name="Username"></param>
''' <remarks></remarks>
Public Sub Login(ByVal Username As String)
If Not Me.Conncected = True Then
Throw New ApplicationException("The client must be connected to a host before logging in")
Exit Sub
End If
Client.Send(Contact.Login, Username)
'//////////////////////////////////////////////////
MsgBox("Login Sent")
End Sub
#End Region
#Region " Events "
Public Event OnConnect()
Public Event OnDisconnect()
Public Event OnServerMessage(ByVal Message As String)
Public Event OnNewMessage(ByVal Message As String)
Public Event onerror(ByVal _Error As Exception)
Public Event OnLoginRejected(ByVal RejectMessage As String)
Private Sub Client_Connect(ByVal sender As RTS_SocketClient) Handles Client.Connect
esConnected = True
RaiseEvent OnConnect()
End Sub
Private Sub Client_Disconnect(ByVal sender As RTS_SocketClient) Handles Client.Disconnect
esConnected = False
RaiseEvent OnDisconnect()
End Sub
Private Sub Client_StringReceived(ByVal Sender As RTS_SocketClient, ByVal msgTag As Byte, ByVal message As String) Handles Client.StringReceived
' Just checks to ensure the right events are raised.
' As a rule of thumb you ownly add server messages to your message display
' just to save confusion.
If msgTag = Contact.ServerMessage Then
RaiseEvent OnServerMessage(message)
ElseIf msgTag = Contact.Normal Then
RaiseEvent OnNewMessage(message)
ElseIf msgTag = Contact.LoginRejected Then
RaiseEvent OnLoginRejected(message)
End If
End Sub
#End Region
End Class
The only thing that I can recommend is adding Password Support here.
Other Notes:
Like I have said before there probably are some bugs here that I haven't seen or found. And if you do find one please tell me and I will attempt to fix it. The reason why this tutorial requires pretty advanced VB coders isnt because the code is particularly hard but the concepts behind the code.
Enjoy your new found P2P knowledge






MultiQuote



|