Imports ArkDLL
Imports System.Runtime.Serialization
Imports System.Runtime.Serialization.Formatters
Imports System.Net.Sockets
Imports System.Xml
Imports System.IO
'''
''' The Self Contained Server Class.
'''
''' Well here we are.
''' Update Log:
''' -6/18/2010-
''' 1. Fixed several explots that could easily tank the server and flood it with requests.
''' 2. Incorporated an IRC-style permission system for the Groups.
''' 3. Several other small bug fixes that improved the speed and reliablity of the server.
''' -6/10/2010-
''' Initial Release.
Public Class TCPV2
#Region " Sub Classes "
'''
''' The Group Sub Class.
'''
''' This Class contains all the code required to maintain groups.
Public Class Group
#Region " Variables "
Private m_Name As String = String.Empty
Private m_Maker As User
Private m_Public As Boolean = False
Private m_UserList As New List(Of User)
#End Region
#Region " Sub Classes "
Public Class User
'''
''' Permission Enum.
'''
'''
Public Enum Permission As Integer
MUTE = 0
VOICE = 1
HALFOP = 2
OP = 3
ADMIN = 4
OWNER = 5
End Enum
Private Property Client As Client
'''
''' Get or Set the User's Permission Level
'''
'''
'''
'''
Public Property PermissionLevel As Permission = Permission.MUTE
'''
''' Creates a new Group User
'''
''' The Client
'''
Public Sub New(ByVal cli As Client)
Client = cli
End Sub
'''
''' Sends a Message to the User.
'''
''' The Message to Send.
'''
Public Sub SendMessage(ByVal obj As Object)
Client.SendMessage(obj)
End Sub
'''
''' Returns the Client Name.
'''
'''
'''
'''
Public ReadOnly Property Name As String
Get
Return Client.Name
End Get
End Property
'''
''' Returns the String Representation of the User
'''
'''
'''
Public Overrides Function ToString() As String
Return Me.Name
End Function
End Class
#End Region
#Region " Events "
'''
''' Event is raised when a Message is received.
'''
''' The Client who sent the message.
''' The actual message.
'''
Friend Event Message(ByVal sender As Client, ByVal message As String, ByVal grp As Group)
'''
''' The Logging Event
'''
''' The Message to Log
'''
Friend Event Log(ByVal msg As String)
'''
''' Raised when the group is empty.
'''
''' The Group that is empty.
'''
Friend Event Empty(ByVal sender As Group)
#End Region
#Region " Initialization and User Management "
'''
''' Create a new Chat Group
'''
''' The name of the Group.
''' The client that created the group.
''' Is the Group a Public or Private group?
'''
Public Sub New(ByVal name As String, ByVal creator As Client, ByVal IsPublic As Boolean)
m_Name = name 'Set the Chatroom name (this is not changeable as of yet).
m_Maker = New User(creator) 'Set the creator (the only administrator).
m_Maker.PermissionLevel = User.Permission.OWNER 'Set to Owner.
m_Public = IsPublic 'Set the room to public if it is or not.
Me.Add(m_Maker) 'Add the creator to the userlist.
End Sub
'''
''' Add a Client to the Group.
'''
''' The client to add.
'''
Public Sub Add(ByVal client As Client)
Dim NewUser As New User(client)
Call Add(NewUser)
End Sub
'''
''' Add's a User to the group
'''
''' The user to add.
'''
Public Sub Add(ByVal User As User)
If Not IsUserInGroup(User) Then
If User.PermissionLevel = User.Permission.MUTE Then User.PermissionLevel = User.Permission.VOICE
If User.Name = Admin.Name Then User.PermissionLevel = TCPV2.Group.User.Permission.OWNER
m_UserList.Add(User)
User.SendMessage(New GroupInfo With {.Added = True, .GroupName = Me.Name, .User = User.Name})
Call ServerMessage(String.Format("{0} has entered the chatroom.", User.Name))
Call Update()
End If
End Sub
'''
''' Remove a client from the group
'''
''' The User to remove. This cannot be the creator.
'''
Public Sub Remove(ByVal User As User)
m_UserList.Remove(User)
Call ServerMessage(String.Format("{0} has left the chatroom.", User.Name))
Call Update()
If m_UserList.Count = 0 Then RaiseEvent Empty(Me)
End Sub
'''
''' Removes a Client from the group
'''
''' The Client to remove
'''
Public Sub Remove(ByVal client As Client)
Dim Usr As User = FindUser(client)
If Usr IsNot Nothing Then
Call Remove(Usr)
End If
End Sub
'''
''' Removes a Client based on their name.
'''
''' The Name to remove.
'''
Public Sub Remove(ByVal name As String)
Dim Usr As User = FindUser(name)
If Usr IsNot Nothing Then Call Remove(Usr)
End Sub
#End Region
#Region " Message Handling "
'''
''' Send a Message from the Server to the chatroom.
'''
''' The Message to send.
'''
Public Sub ServerMessage(ByVal message As String)
Dim Msg As New ArkDLL.GroupMessage With {.GroupName = Me.m_Name, .Message = message, .Sender = "SERVER"}
For Each usr As User In m_UserList
usr.SendMessage(Msg)
Next
End Sub
'''
''' Send a new Userlist to each person.
'''
'''
Public Sub Update()
RaiseEvent Log("Creating a GroupList.")
Dim newList As New GroupList With {.GroupName = Me.Name}
Dim UserList As List(Of String) = Me.Group(True)
newList.GroupList = UserList
For Each cli As User In m_UserList
RaiseEvent Log(String.Format("Sent list to {0}", cli.Name))
cli.SendMessage(newList)
Next
End Sub
'''
''' Send a Message to the Group.
'''
''' The Client that's sending the message.
''' The message to send.
'''
Public Sub Send(ByVal sender As User, ByVal message As String)
If IsUserInGroup(sender) AndAlso sender.PermissionLevel > 0 Then 'make sure the user is in the group.
'See if it's a command we can parse.
If message.StartsWith("/command") Then
'Now to find out what to do.
Dim MsgArr() As String = message.Split(" "c)
Select Case MsgArr(1).ToLower
Case "voice"
'Set to Voice.
Call SetStatus(sender, MsgArr(2), User.Permission.VOICE)
Case "devoice"
'Set to None.
Call SetStatus(sender, MsgArr(2), User.Permission.MUTE)
Case "hop"
'Set to Half Operator
Call SetStatus(sender, MsgArr(2), User.Permission.HALFOP)
Case "dehop"
'Set to Voice.
Call SetStatus(sender, MsgArr(2), User.Permission.VOICE)
Case "op"
'Set to Operator.
Call SetStatus(sender, MsgArr(2), User.Permission.OP)
Case "deop"
'Set to Voice.
Call SetStatus(sender, MsgArr(2), User.Permission.VOICE)
Case "admin"
'Set to Admin.
Call SetStatus(sender, MsgArr(2), User.Permission.ADMIN)
Case "deadmin"
'Set to Voice.
Call SetStatus(sender, MsgArr(2), User.Permission.VOICE)
Case "kick"
Call KickUser(sender, MsgArr(2))
End Select
Else
'Raise an event.
'RaiseEvent Message(sender.Client, message, Me)
Dim MessageToSend As New GroupMessage With {.GroupName = Me.Name, .Message = message, .Sender = sender.Name}
'create the message
For Each UsrClient As User In m_UserList
'create a for loop to send the message to each person.
UsrClient.SendMessage(MessageToSend) 'send message.
Next
End If
ElseIf sender.PermissionLevel = 0 Then
sender.SendMessage("You do not have the required permission levels to speak!")
End If
End Sub
#End Region
#Region " Properties and Functions "
'''
''' Return the Group Name
'''
'''
'''
'''
Public ReadOnly Property Name() As String
Get
Return m_Name 'Return the name of the chatroom.
End Get
End Property
'''
''' Returns the Administrator of the Chatroom.
'''
'''
'''
'''
Public ReadOnly Property Admin() As User
Get
Return m_Maker 'return admin.
End Get
End Property
'''
''' Returns if the Group is a Public group or not.
'''
'''
'''
'''
Public Property IsPublic As Boolean
Get
Return m_Public
End Get
Set(ByVal value As Boolean)
m_Public = value
End Set
End Property
'''
''' Return the User list as a List(Of String)
'''
''' If the List is sorted or not.
'''
'''
Public Function Group(ByVal sorted As Boolean) As List(Of String)
'Create a list of string to store the returned values
Dim ClientList As New List(Of String)
'make a for loop
For Each item As User In m_UserList
'add the client's name to the list.
Dim PreLetter As String = String.Empty
Select Case item.PermissionLevel
Case User.Permission.ADMIN
PreLetter = "[Adm] "
Case User.Permission.HALFOP
PreLetter = "[H] "
Case User.Permission.MUTE
PreLetter = "[M] "
Case User.Permission.OP
PreLetter = "[Op] "
Case User.Permission.OWNER
PreLetter = "[Own] "
Case User.Permission.VOICE
PreLetter = "[V] "
End Select
ClientList.Add(String.Format("{0}{1}", PreLetter, item.Name))
Next
'if we want it sorted, then sort
If sorted Then ClientList.Sort()
'return the list.
Return ClientList
End Function
'''
''' Returns the User list as a List(Of Client)
'''
'''
'''
Public Function Group() As List(Of User)
'return the client list.
Return m_UserList
End Function
'''
''' See if a user is in the group.
'''
''' The User to check.
'''
'''
Public Function IsUserInGroup(ByVal User As User) As Boolean
'Setup a for loop to see if the user exists in the group.
For Each item As User In m_UserList
'If we found them, return true.
If item Is User Then Return True
Next
'user wasn't found, return false.
Return False
End Function
'''
''' See if a user is in the group.
'''
''' The client to look for.
'''
'''
Public Function IsUserInGroup(ByVal client As Client) As Boolean
Dim Usr As User = FindUser(client)
If Usr IsNot Nothing Then
Return IsUserInGroup(Usr)
End If
Return False
End Function
'''
''' See ifa user is in the group.
'''
''' The name to look for.
'''
'''
Public Function IsUserInGroup(ByVal name As String) As Boolean
'Setup a for loop to see if the user exists in the group.
For Each item As User In m_UserList
'If we found them, return true.
If item.Name = name Then Return True
Next
'user wasn't found, return false.
Return False
End Function
'''
''' Returns a User based on the username.
'''
''' The Username to look for.
'''
'''
Public Function ReturnUser(ByVal username As String) As User
SyncLock m_UserList
For Each item As User In m_UserList
If item.Name = username Then Return item
Next
End SyncLock
Return Nothing
End Function
'''
''' Returns the String Representation of the Group
'''
'''
'''
Public Overrides Function ToString() As String
Return Me.Name
End Function
#End Region
#Region " Misc. Subs "
'''
''' Disposes of the Group.
'''
'''
Public Sub Dispose()
Dim GMsg As New GroupMessage With {.Sender = "SERVER", .Message = "DISPOSE", .GroupName = Me.Name}
For Each cli As User In m_UserList
cli.SendMessage(GMsg)
Next
End Sub
'''
''' Returns the User Object based on the Client Object.
'''
''' The Client Object to locate.
''' The User Object
'''
Public Function FindUser(ByVal Cli As Client) As User
Return FindUser(Cli.Name)
End Function
'''
''' Returns the User Object based on the Client's Name.
'''
''' The Name of the User to locate.
''' The User Object
'''
Public Function FindUser(ByVal Name As String) As User
For i As Integer = m_UserList.Count - 1 To 0 Step -1
If m_UserList(i).Name = Name Then Return m_UserList(i)
Next
Return Nothing
End Function
#End Region
#Region " Group Administration Commands "
'''
''' An Administrative Only sub. It kicks the specified person.
'''
''' The Client sending the kick request.
''' The name of the client to kick.
'''
Private Sub KickUser(ByVal sender As User, ByVal PersonToKick As String)
RaiseEvent Log("Kicking attempt.")
'If the sender is half op or higher, is in the group, not kicking the owner, AND sender is also above the person being kicked.
If (sender.PermissionLevel >= User.Permission.HALFOP) AndAlso IsUserInGroup(sender) AndAlso (FindUser(PersonToKick).PermissionLevel < User.Permission.OWNER) AndAlso (FindUser(PersonToKick).PermissionLevel < sender.PermissionLevel) Then
RaiseEvent Log(String.Format("Valid attempt by a half op or higher. {0}", sender.Name))
'Since the sender is the Admin, we can do this.
For i As Integer = m_UserList.Count - 1 To 0 Step -1
'Work down the list, looking for the user.
'If the name and the person to kick is true
If m_UserList(i).Name = PersonToKick Then
'Remove them.
Call ServerMessage(String.Format("{0} has removed {1} from the chat room.", sender.Name, PersonToKick))
m_UserList.RemoveAt(i)
'Now call the update
Call Update()
End If
Next
End If
End Sub
'''
''' Set's a User's new status.
'''
''' The Person doing the modifiying.
''' The name of the user being modified.
''' The level they are being sent to.
'''
Public Sub SetStatus(ByVal sender As User, ByVal modified As String, ByVal NewLevel As User.Permission)
'If they aren't just standard voice, and their permission is greater than or equal to the New Level.
If (sender.PermissionLevel > User.Permission.VOICE) AndAlso (sender.PermissionLevel >= NewLevel) Then
Dim Usr As User = FindUser(modified)
'If User isn't nothing, Permission isn't the same, they aren't the owner, and if the sender is actually the same or higher (to prevent half ops from fucking over operators, etc)
If (Usr IsNot Nothing) AndAlso (Usr.PermissionLevel <> NewLevel) AndAlso (Usr.PermissionLevel < User.Permission.OWNER) AndAlso (sender.PermissionLevel >= Usr.PermissionLevel) Then
If (sender Is Admin) AndAlso (Usr Is Admin) AndAlso (NewLevel < User.Permission.OWNER) Then
Else
'Awesome. All requirements met.
Usr.PermissionLevel = NewLevel
'Tell the chatroom.
Call ServerMessage(String.Format("{0} has changed {1}'s level to {2}", sender.Name, modified, NewLevel.ToString))
'Update the user list.
Call Update()
End If
End If
End If
End Sub
'''
''' Server Side Edit on a user. It will not override the Owner Level, nor set someone else to owner.
'''
''' The Username to manipulate.
''' The new status.
'''
Public Sub SetOverrideStatus(ByVal username As String, ByVal NewStatus As User.Permission)
If IsUserInGroup(username) Then
Dim User As User = ReturnUser(username)
If User.PermissionLevel < TCPV2.Group.User.Permission.OWNER AndAlso NewStatus <> TCPV2.Group.User.Permission.OWNER Then
User.PermissionLevel = NewStatus
ServerMessage(String.Format("Override from server. {0} is now {1}", username, NewStatus.ToString))
Call Update()
End If
End If
End Sub
'''
''' Invokes a Server kick, which will remove any user BUT the owner.
'''
''' The Username to kick.
'''
Public Sub KickOverrideUser(ByVal username As String)
For i As Integer = m_UserList.Count - 1 To 0 Step -1
'Work down the list, looking for the user.
'If the name and the person to kick is true
If m_UserList(i).Name = username Then
'Remove them.
'If Not ReturnUser(username).PermissionLevel = User.Permission.OWNER Then
Call ServerMessage(String.Format("{0} has been removed from the chat room by the server.", username))
m_UserList.RemoveAt(i)
'Now call the update
Call Update()
'End If
End If
Next
End Sub
#End Region
End Class
'''
''' The Client Sub Class.
'''
''' This Class contains all the code required to maintain connections to clients.
Public Class Client
#Region " Variables "
Private readThread As Threading.Thread 'Reader thread.
Private m_Name As String = String.Empty 'client's name.
Private m_Client As TcpClient 'the tcp client, do not ever dispose this!
Private BinFormatter As Binary.BinaryFormatter 'The binary formatter that handles our queries.
Private m_FriendList As New List(Of User) 'the friends list!
Private m_Status As String = String.Empty 'The client's status.
Private m_Password As String = String.Empty 'the client's password.
Private m_Display As String = String.Empty 'the client's display name.
Private m_Read As Boolean = True
Friend UIC As New UserInterfaceClass
#End Region
#Region " Sub Class "
Public Class UserInterfaceClass
'Variable Declarations
'Used for saving and loading.
#Region " Properties "
Public Property Password As String = String.Empty
Public Property Status As String = String.Empty
Public Property Display As String = String.Empty
Public Property Friends As New List(Of String)
Public Property IP As String = String.Empty
#End Region
'''
''' Save the User to an XML file.
'''
''' The Username to save.
'''
'''
Friend Function SaveUser(ByVal FileName As String) As Boolean
If FileName = String.Empty Then Return False
Try
FileName = String.Format("{0}\Users\{1}.xml", Application.StartupPath, FileName)
Debug.WriteLine(FileName)
If File.Exists(FileName) Then File.Delete(FileName)
Dim XmlDoc As New XmlTextWriter(FileName, System.Text.Encoding.UTF8) With {.Formatting = Formatting.Indented}
XmlDoc.WriteStartDocument() 'Start
XmlDoc.WriteStartElement("information") '
XmlDoc.WriteStartElement("password") '
XmlDoc.WriteString(Me.Password)
XmlDoc.WriteEndElement() '
XmlDoc.WriteStartElement("display") '
XmlDoc.WriteString(Me.Display)
XmlDoc.WriteEndElement() '
XmlDoc.WriteStartElement("status") '
XmlDoc.WriteString(Me.Status)
XmlDoc.WriteEndElement() '
XmlDoc.WriteStartElement("ip") '
XmlDoc.WriteString(Me.IP)
XmlDoc.WriteEndElement() '
If Me.Friends.Count > 0I Then
XmlDoc.WriteStartElement("friends") '
For Each item As String In Me.Friends
XmlDoc.WriteStartElement("name") '
XmlDoc.WriteString(item) '-
XmlDoc.WriteEndElement() '
Next
XmlDoc.WriteEndElement() '
End If
XmlDoc.WriteEndElement() '
XmlDoc.WriteEndDocument() 'End
XmlDoc.Close()
Catch ex As Exception
Return False
End Try
Return True
End Function
'''
''' Load the selected Username.
'''
''' The Username to load.
''' True/False
'''
Friend Function LoadUser(ByVal FileName As String) As Boolean
Me.Dispose()
Dim XmlDoc As New XmlDocument
FileName = String.Format("{0}\Users\{1}.xml", Application.StartupPath, FileName)
Try
XmlDoc.Load(FileName)
Dim InformationList As XmlNodeList = XmlDoc.SelectNodes("information")
Dim FriendsList As XmlNodeList = XmlDoc.SelectNodes("friends")
If InformationList.Count > 0I Then
With InformationList(0)
Me.Password = .Item("password").InnerText
Me.Status = .Item("status").InnerText
Me.Display = .Item("display").InnerText
Try
Me.IP = .Item("ip").InnerText
Catch ex As Exception
'No IP? We'll save it next time.
End Try
End With
FriendsList = InformationList(0).SelectNodes("friends/name")
For FriendsCounter As Integer = FriendsList.Count - 1I To 0I Step -1
With FriendsList(FriendsCounter)
Try
If .InnerText <> String.Empty Then
Debug.WriteLine(.InnerText)
Me.Friends.Add(.InnerText)
End If
Catch ex As NullReferenceException
Debug.WriteLine("He has no friends!")
End Try
End With
Next FriendsCounter
End If
XmlDoc = Nothing
Return True
Catch ex As Exception
Debug.WriteLine(ex.ToString)
Return False
Finally
XmlDoc = Nothing
End Try
End Function
'''
''' Reset the UIC
'''
'''
Friend Sub Dispose()
Me.Password = String.Empty
Me.Status = String.Empty
Me.Display = String.Empty
Me.Friends.Clear()
End Sub
End Class
#End Region
#Region " Events "
'''
''' The Message Received Event.
'''
''' The Client that sent the message.
''' The Object the client sent.
'''
Friend Event Message(ByVal cli As Client, ByVal obj As Object)
'''
''' The Error Event for a Client.
'''
''' The Client that threw the error.
''' The exception data.
'''
Friend Event ErrorOut(ByVal cli As Client, ByVal err As Exception)
'''
''' Our Timer for checking for timeouts.
'''
'''
Private WithEvents TimeoutTimer As New System.Timers.Timer With {.Interval = 5000, .AutoReset = True, .Enabled = False}
#End Region
#Region " Properties "
'''
''' Get or Set the Name of the Client.
'''
'''
'''
'''
Public Property Name() As String
Get
Return m_Name
End Get
Set(ByVal value As String)
m_Name = value
End Set
End Property
'''
''' Get or Set the Client's Friend List.
'''
'''
'''
'''
Public Property Friends As List(Of User)
Get
Return m_FriendList
End Get
Set(ByVal value As List(Of User))
m_FriendList = value
End Set
End Property
'''
''' Get or Set the Client's Status
'''
'''
'''
'''
Public Property Status As String
Get
Return m_Status
End Get
Set(ByVal value As String)
m_Status = value
If value <> String.Empty Then SendMessage(New User With {.User = Name, .Status = Status, .Online = True, .Display = Display})
End Set
End Property
'''
''' Get or Set the Client's Password
'''
'''
'''
'''
Public Property Password() As String
Get
Return m_Password
End Get
Set(ByVal value As String)
m_Password = value
End Set
End Property
'''
''' Get or Set the Client's Display Name
'''
'''
'''
'''
Public Property Display() As String
Get
Return m_Display
End Get
Set(ByVal value As String)
m_Display = value
If value <> String.Empty Then SendMessage(New User With {.User = Name, .Status = Status, .Online = True, .Display = Display})
End Set
End Property
#End Region
#Region " Friend Subs "
'''
''' Add a friend to the Client's Friend List.
'''
''' The Friend name to add.
''' The status of the friend to add.
'''
Public Sub AddFriend(ByVal friendName As String, ByVal friendStatus As String, ByVal online As Boolean, ByVal Display As String)
SyncLock m_FriendList
If Not IsUserInFriendList(friendName) Then
Dim NewFriend As New User With {.User = friendName, .Status = friendStatus, .Online = online, .Display = Display}
m_FriendList.Add(NewFriend)
If online Then
SendMessage(NewFriend)
End If
End If
End SyncLock
End Sub
'''
''' Add a friend to the Client's Friend List.
'''
''' The User Structure.
'''
Public Sub AddFriend(ByVal FriendData As User)
Call AddFriend(FriendData.User, FriendData.Status, FriendData.Online, FriendData.Display)
End Sub
'''
''' Update a friend's Status.
'''
''' The Friend's Name.
''' Their new Status.
'''
Public Sub UpdateFriend(ByVal friendName As String, ByVal newStatus As String, ByVal online As Boolean, ByVal display As String)
Call UpdateFriend(New User With {.User = friendName, .Status = newStatus, .Online = online, .Display = display})
End Sub
'''
''' Update a friend's Status
'''
''' The User to update.
'''
Public Sub UpdateFriend(ByVal User As User)
SendMessage(User)
End Sub
'''
''' Construct the User's Friend List.
'''
'''
'''
Public ReadOnly Property BuildFriendList() As String
Get
Dim StrBld As New System.Text.StringBuilder
For Each item As User In m_FriendList
StrBld.Append(String.Format("{0}|", item.User))
Next
Return StrBld.ToString.Trim("|"c)
End Get
End Property
'''
''' Send the Friends List
'''
'''
Public Sub SendFriendList()
Dim FList As New FriendList
Dim UList As New List(Of User)
For Each item As User In Friends
If item.Online Then UList.Add(item)
Next
FList.Friends = UList
SendMessage(FList)
End Sub
'''
''' Send a Friends List
'''
''' The Friends List to send.
'''
Public Sub SendFriendList(ByVal friendList As FriendList)
SendMessage(friendList)
End Sub
'''
''' Remove a Friend from the Client's Friend List.
'''
''' The name of the Friend to remove.
'''
Public Sub RemoveFriend(ByVal name As String)
For i As Integer = Friends.Count - 1 To 0 Step -1
If Friends(i).User = name Then
SendMessage(New User With {.User = Friends(i).User, .Status = "Offline", .Online = False, .Display = Friends(i).Display})
Friends.RemoveAt(i)
End If
Next
End Sub
'''
''' Checks to see if someone exists in your friend's list.
'''
''' The name to look for.
'''
'''
Public Function IsUserInFriendList(ByVal name As String) As Boolean
SyncLock Me.Friends
For Each item As User In Me.Friends
If item.User = name Then Return True
Next
Return False
End SyncLock
End Function
#End Region
#Region " Subs "
'''
''' Create a new Client.
'''
''' The TCP Client that's connecting.
'''
Public Sub New(ByVal client As TcpClient)
m_Client = client 'Transfer over the TcpClient to this class.
readThread = New System.Threading.Thread(AddressOf client_doRead) 'create new reading thread.
readThread.IsBackground = True 'set it to the background to not disturb the server
readThread.Start() 'start it.
TimeoutTimer.Enabled = True 'create our timeout timer.
End Sub
'''
''' This should only be called internally by the program. DO NOT MAKE DIRECT CALLS TO THIS!
'''
'''
Public Sub New()
End Sub
'''
''' The infinite doRead() sub. Handles all reading from the client.
'''
'''
Private Sub client_doRead()
Try
Do While m_Read = True
BinFormatter = New Binary.BinaryFormatter()
'create a generic object
Dim obj As New Object
'deserialize the stream when a message comes in.
obj = BinFormatter.Deserialize(m_Client.GetStream)
RaiseEvent Message(Me, obj)
Loop
Catch ex As Threading.ThreadAbortException
'Thread aborting. That's OK. I'm game with this.
Debug.WriteLine("Threading Exception, probably aborted.")
Catch ex As SerializationException
Debug.WriteLine("Serialization Error, that's not good.")
RaiseEvent ErrorOut(Me, ex)
Me.Dispose()
Catch ex As IOException
Debug.WriteLine("IO Exception. Stream died.")
RaiseEvent ErrorOut(Me, ex)
Me.Dispose()
Catch ex As Exception
Debug.WriteLine("General Exception")
RaiseEvent ErrorOut(Me, ex)
Me.Dispose()
End Try
End Sub
'''
''' Send a Serialized Message to the Client. The Types are in the ArkDLL.
'''
''' The Object to send.
'''
Public Sub SendMessage(ByVal message As Object)
Dim SMAT As New Threading.Thread(New Threading.ParameterizedThreadStart(AddressOf SendMessageAsync))
SMAT.Start(message)
End Sub
'''
''' Sends a message across the stream Asynchronously.
'''
''' The message to send.
'''
Private Sub SendMessageAsync(ByVal message As Object)
Try
SyncLock m_Client.GetStream
BinFormatter = New Binary.BinaryFormatter()
BinFormatter.Serialize(m_Client.GetStream, message)
BinFormatter = Nothing
End SyncLock
Catch BSE As SerializationException
Debug.WriteLine(BSE.ToString)
Me.Dispose()
Catch exi As InvalidOperationException
'Debug.WriteLine(exi.StackTrace)
Debug.WriteLine(exi.Data.Item(0).ToString)
Me.Dispose()
Catch ex As Exception
'The stream is broken.
Debug.WriteLine(ex.ToString)
Me.Dispose()
End Try
End Sub
'''
''' Save the User to file. Generally, this is called whenever the user is logging off and whenever the
''' server shuts down.
'''
'''
Public Sub SaveUser()
Try
'Update the XML Information
UIC.Password = Me.Password
UIC.Status = Me.Status
UIC.Display = Me.Display
UIC.IP = Me.PublicIPAddress
UIC.Friends.Clear()
SyncLock Me.Friends
For Each item As User In Me.Friends
UIC.Friends.Add(item.User)
Next
End SyncLock
'Save the User
UIC.SaveUser(Me.Name)
Catch ex As Exception
RaiseEvent ErrorOut(Me, ex)
End Try
End Sub
'''
''' Load the User from a file. This can only be called once.
''' It is recommended to send a Friends List AFTER loading is complete.
'''
''' The User to load.
'''
Public Function LoadUser(ByVal user As String, ByVal pass As String) As Boolean
If UIC.LoadUser(user) Then
'Compare Passwords
If UIC.Password = pass Then
'Hooray! Passwords check out.
Me.Name = user 'Set User
Me.Password = pass 'Set Pass
Me.Status = UIC.Status 'Set Status
Me.Display = UIC.Display 'Set Display
'Set Friends List.
For Each item As String In UIC.Friends
Me.Friends.Add(New User With {.User = item})
Next
Return True
End If
End If
Return False
End Function
'''
''' Dispose of the Client
'''
'''
Public Sub Dispose()
'Save just in case
Me.SaveUser()
'Throw the error.
RaiseEvent ErrorOut(Me, New Exception("Client is Disposed."))
End Sub
'''
''' Resets a few variables to nothing.
'''
'''
Public Sub VariableReset()
TimeoutTimer.Stop()
TimeoutTimer.Dispose()
m_Name = String.Empty
m_Display = String.Empty
m_Status = String.Empty
m_Password = String.Empty
m_Read = False
BinFormatter = Nothing
Try
readThread.Abort()
Catch
End Try
m_Client.Close()
m_Client.Client.Close()
GC.Collect()
End Sub
'''
''' Check to see if the client has been f**ked.
'''
'''
'''
'''
Private Sub TimeoutTimer_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles TimeoutTimer.Elapsed
RaiseEvent Message(Me, New Message With {.Sender = Me.Name, .Receiver = "SERVER", .Message = String.Format("Ping to {0}", Me.Name)})
Me.SendMessage(New Message With {.Message = "ping"})
End Sub
Public Overrides Function ToString() As String
Return Me.Name
End Function
Private PublicIP As String = String.Empty
'''
''' Returns the IP address of the Client.
'''
'''
'''
'''
Public ReadOnly Property PublicIPAddress() As String
Get
If PublicIP = String.Empty Then
Try
' Get the clients IP address using Client property
Dim ipend As Net.IPEndPoint = CType(m_Client.Client.RemoteEndPoint, Net.IPEndPoint)
If Not ipend Is Nothing Then
PublicIP = ipend.Address.ToString
End If
Catch ex As System.ObjectDisposedException
PublicIP = String.Empty
Catch ex As SocketException
PublicIP = String.Empty
End Try
End If
Return PublicIP
End Get
End Property
#End Region
End Class
'''
''' The Item Queue Class. Very important for managing offline messages and friend requests.
'''
'''
Public Class ItemQueue
#Region " Variables "
Private TCPLoop As TCPV2
#End Region
#Region " Misc. Subs "
'''
''' Creates a new ItemQueue Class to store data for offline people.
'''
''' A reference to the TCP Server
'''
Public Sub New(ByRef server As TCPV2)
TCPLoop = server
End Sub
#End Region
#Region " Structures "
'''
''' User Queue Structure. Fill all the data in.
'''
'''
Public Structure UserQueueData
'''
''' Gets or Sets the User that the data is for.
'''
'''
'''
'''
Public Property User As String
'''
''' The User that is to be added to the friend list
''' when someone comes online.
'''
'''
'''
'''
Public Property Data As User
End Structure
'''
''' Message Queue Structure. For Offline Messages.
'''
'''
Public Structure MessageQueueData
'''
''' Gets or Sets the User that the data is for.
'''
'''
'''
'''
Public Property User As String
'''
''' Gets or Sets the Message to transmit.
'''
'''
'''
'''
Public Property Message As Message
End Structure
'''
''' Structure for Removing a User.
'''
'''
Public Structure RemoveUserQueueData
'''
''' Gets or Sets the User that the data is for.
'''
'''
'''
'''
Public Property User As String
'''
''' The name of the friend to remove.
'''
'''
'''
'''
Public Property RemoveFriend As String
End Structure
#End Region
#Region " Properties "
'''
''' The User Queue is a list used to store what user needs to add new
''' friends when they login.
'''
'''
'''
'''
Private Property UserQueue As New List(Of UserQueueData)
'''
''' The Message Queue is used to store offline messages.
'''
'''
'''
'''
Private Property MessageQueue As New List(Of MessageQueueData)
'''
''' The Queue used to store remove friend requests.
'''
'''
'''
'''
Private Property RemoveQueue As New List(Of RemoveUserQueueData)
#End Region
#Region " Evaluation Subs "
'''
''' Evaluates Offline friend requests.
'''
''' The Client to manipulate.
'''
Public Sub EvaluateUserQueue(ByRef user As Client)
'Get the Username.
Dim ClientName As String = user.Name
Debug.WriteLine(ClientName)
'Lock the User Queue.
SyncLock UserQueue
'For Loop, going in reverse.
For i As Integer = UserQueue.Count - 1 To 0 Step -1
'Check to see if this is the right user.
If UserQueue(i).User = ClientName Then
Debug.WriteLine(String.Format("Offline Friend Request for {0}!", ClientName))
'it is, so add the friend.
Dim Data As User = UserQueue(i).Data
Data.Online = TCPLoop.UserLoggedIn(Data.User)
user.AddFriend(Data)
'Remove it from the queue since we're done.
UserQueue.RemoveAt(i)
End If
'Item was checked, go on to the next one.
Next
End SyncLock
End Sub
'''
''' Evaluates the Message Queue for offline messages.
'''
''' The Client to modify.
'''
Public Sub EvaluateMessageQueue(ByRef user As Client)
Try
'Get the Username.
Dim ClientName As String = user.Name
Debug.WriteLine(ClientName)
'Lock the User Queue.
SyncLock MessageQueue
'Setup the loop, going normal way
For i As Integer = 0 To MessageQueue.Count - 1
'If this is the right user.
If MessageQueue(i).User = ClientName Then
Debug.WriteLine(String.Format("Offline Message Found for {0}!", ClientName))
'send them a message.
user.SendMessage(MessageQueue(i).Message)
'now remove it
MessageQueue.RemoveAt(i)
'go back one.
i -= 1
End If
Next
End SyncLock
Catch ex As IndexOutOfRangeException
Catch ex As ArgumentOutOfRangeException
End Try
End Sub
'''
''' Evaluates the Remove Queue for the user.
'''
''' Reference to the User.
'''
Public Sub EvaluateRemoveQueue(ByRef user As Client)
'Get the Username.
Dim ClientName As String = user.Name
'Lock the Queue.
SyncLock RemoveQueue
'For Loop, going in reverse.
For i As Integer = RemoveQueue.Count - 1 To 0 Step -1
'Check to see if this is the right user.
If RemoveQueue(i).User = ClientName Then
'it is, so add the friend.
user.RemoveFriend(RemoveQueue(i).RemoveFriend)
RemoveQueue.RemoveAt(i)
End If
Next
End SyncLock
End Sub
#End Region
#Region " Adding Subs "
'''
''' Adds a new item to the Offline Message Queue.
'''
''' The User that the message is being sent to.
''' The Message that needs to be stored.
'''
Public Sub AddOfflineMessage(ByVal user As String, ByVal message As Message)
MessageQueue.Add(New MessageQueueData With {.User = user, .Message = message})
Debug.WriteLine(String.Format("New Offline Message for {0} from {1}", user, message.Sender))
End Sub
'''
''' Adds a new item to the Offline Friend Request Queue.
'''
''' The user to send the request to.
''' The Friend Data.
'''
Public Sub AddOfflineFriendRequest(ByVal user As String, ByVal FriendData As User)
UserQueue.Add(New UserQueueData With {.User = user, .Data = FriendData})
Debug.WriteLine(String.Format("New Friend Request for {0} from {1}", user, FriendData.User))
End Sub
'''
''' Adds a new item to the Offline Removal Request Queue
'''
''' The one who's friend list needs to be modified.
''' The name of the friend to remove.
'''
Public Sub AddOfflineRemoveRequest(ByVal user As String, ByVal name As String)
RemoveQueue.Add(New RemoveUserQueueData With {.RemoveFriend = name, .User = user})
End Sub
#End Region
End Class
#End Region
#Region " Event Structures & Enums "
Public Enum MessageTypeEnum
Standard = 0
Group = 1
End Enum
Public Structure MessageEventArgs
'''
''' The Message to pass in.
'''
'''
'''
'''
Public Property Message As String
Public Property Type As MessageTypeEnum
Public Property sender As Client
End Structure
Public Structure GroupCreationEventArgs
Public Group As Group
End Structure
Public Structure LoginEventArgs
'''
''' The client that logged in.
'''
'''
'''
'''
Public Property Client As Client
End Structure
Public Structure LogoffEventArgs
'''
''' The client that logged in.
'''
'''
'''
'''
Public Property Client As Client
End Structure
Public Structure RegistrationEventArgs
Public Property Client As Client
End Structure
#End Region
#Region " Variables "
Private m_GroupList As New List(Of Group)
Private m_Users As New List(Of Client)
Private ServerListener As TcpListener
Private IncomingClient As TcpClient
Private ListenThread As System.Threading.Thread
Private QueueList As New ItemQueue(Me)
Private ReadOnly m_DataDirectory As String = String.Format("{0}\Users\", Application.StartupPath)
#End Region
#Region " Properties "
Public ReadOnly Property Groups As List(Of Group)
Get
Return m_GroupList
End Get
End Property
Public ReadOnly Property Users As List(Of Client)
Get
Return m_Users
End Get
End Property
Private WriteOnly Property Add As Client
Set(ByVal value As Client)
m_Users.Add(value)
End Set
End Property
Private WriteOnly Property Remove As Client
Set(ByVal value As Client)
m_Users.Remove(value)
End Set
End Property
#End Region
#Region " Events "
Public Event Message(ByVal sender As Object, ByVal e As MessageEventArgs) 'Message
Public Event Login(ByVal sender As Object, ByVal e As LoginEventArgs) 'Someone logging in.
Public Event Logoff(ByVal sender As Object, ByVal e As LogoffEventArgs) 'Someone logging out.
Public Event Registration(ByVal sender As Object, ByVal e As RegistrationEventArgs) 'Registration.
Public Event GroupCreated(ByVal sender As Object, ByVal e As GroupCreationEventArgs) 'Group created.
'''
''' Called when a message comes in.
'''
''' The message that is called.
'''
Protected Overridable Sub OnMessageReceived(ByVal msg As MessageEventArgs)
RaiseEvent Message(Me, msg)
End Sub
'''
''' Called when a Client Message comes in.
'''
''' The Arguments.
'''
Protected Overridable Sub OnClientMessageReceived(ByVal msg As MessageEventArgs)
RaiseEvent Message(Me, msg)
End Sub
'''
''' Called when a Client logs in.
'''
''' Login Event Argument data
'''
Protected Overridable Sub OnClientLogin(ByVal data As LoginEventArgs)
RaiseEvent Login(Me, data)
End Sub
'''
''' Called when a Client logs off.
'''
'''
'''
Protected Overridable Sub OnClientLogoff(ByVal data As LogoffEventArgs)
RaiseEvent Logoff(Me, data)
End Sub
'''
''' Called when a Client registers.
'''
'''
'''
Protected Overridable Sub OnClientRegistration(ByVal data As RegistrationEventArgs)
RaiseEvent Registration(Me, data)
End Sub
Protected Overridable Sub OnGroupCreation(ByVal data As GroupCreationEventArgs)
RaiseEvent GroupCreated(Me, data)
End Sub
#End Region
#Region " Server Code "
'''
''' Create a new Server Class on the specified port.
'''
''' Optional. Defaults to port 6110 if not specified.
'''
Public Sub New(Optional ByVal port As Integer = 6110I)
ServerListener = New TcpListener(Net.IPAddress.Any, port)
GroupPurgeTimer.AutoReset = True
GroupPurgeTimer.Enabled = True
GroupPurgeTimer.Interval = 30000I
End Sub
'''
''' Initialize the Server.
'''
'''
Public Sub Initialize()
Me.OnMessageReceived(New MessageEventArgs With {.Message = "Starting Server...."})
ServerListener.Start()
Me.OnMessageReceived(New MessageEventArgs With {.Message = "Server started, creating Listener Thread."})
ListenThread = New System.Threading.Thread(AddressOf Listener)
Me.OnMessageReceived(New MessageEventArgs With {.Message = "Listener Thread Created, setting to Background."})
ListenThread.IsBackground = True
Me.OnMessageReceived(New MessageEventArgs With {.Message = "Starting listener..."})
ListenThread.Start()
Me.OnMessageReceived(New MessageEventArgs With {.Message = "Server Startup Complete."})
End Sub
'''
''' The Listener Sub, constantly looping, waiting for new Clients.
'''
'''
Private Sub Listener()
Try
Do
IncomingClient = ServerListener.AcceptTcpClient()
Dim Client As New Client(IncomingClient)
'Perform IP filter here. If function returns true, they're
'safe to pass.
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Client Accepted, registering handlers.")})
AddHandler Client.Message, AddressOf GeneralMessageHandler
AddHandler Client.ErrorOut, AddressOf ErrorHandler
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Adding to Online List.")})
Add = Client
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Waiting for Response.")})
Loop
Catch ex As Exception
Me.OnMessageReceived(New MessageEventArgs With {.Message = (ex.Message.ToString)})
End Try
End Sub
'''
''' Error handling sub that logs all exceptions by the server.
'''
''' The Client that threw the error.
''' The exception.
'''
Private Sub ErrorHandler(ByVal sender As Client, ByVal ex As Exception)
'Remove from the online list.
Remove = sender
'Save the Client if nothing is wrong and if the name isn't empty (invalid client?)
If sender.Name <> String.Empty Then sender.SaveUser()
'log the exception
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("The client '{0}' threw an error:{1}{2}", sender.Name, Environment.NewLine, ex.ToString))})
'Remove them from any possible groups. (SyncLocking just in case)
SyncLock m_GroupList
For i As Integer = m_GroupList.Count - 1 To 0 Step -1
Try
If m_GroupList(i).IsUserInGroup(sender) Then m_GroupList(i).Remove(sender)
Catch RemoveFromGroupException As Exception
Me.OnMessageReceived(New MessageEventArgs With {.Message = String.Format("Error removing {0} from a group.{1}{2}", sender.Name, Environment.NewLine, RemoveFromGroupException.ToString)})
End Try
Next
End SyncLock
'Now alert his friends.
SyncLock sender.Friends
For Each item As User In sender.Friends
If UserLoggedIn(item.User) Then
Dim PersonToUpdate As Client = ReturnClient(item.User)
PersonToUpdate.UpdateFriend(New User With {.User = sender.Name, .Status = sender.Status, .Online = False, .Display = sender.Display})
End If
Next
End SyncLock
'Remove Handlers
RemoveHandler sender.Message, AddressOf GeneralMessageHandler
RemoveHandler sender.ErrorOut, AddressOf ErrorHandler
'Reset their variables.
sender.VariableReset()
'Now raise the logoff signal.
Me.OnClientLogoff(New LogoffEventArgs With {.Client = sender})
'Run garbage collection
GC.Collect()
End Sub
'''
''' The General Message Handler (GMH). This sub directs all calls to the respective handlers.
'''
''' The Client that is sending the data.
''' The data the Client sent.
'''
Private Sub GeneralMessageHandler(ByVal sender As Client, ByVal Data As Object)
If Data.GetType Is GetType(Register) Then Call RegistrationHandler(sender, CType(Data, Register)) : Return
If Data.GetType Is GetType(Login) Then Call LoginHandler(sender, CType(Data, Login)) : Return
If Data.GetType Is GetType(Message) Then Call MessageHandler(sender, CType(Data, Message)) : Return
If Data.GetType Is GetType(AddFriend) Then Call AddFriendHandler(sender, CType(Data, AddFriend)) : Return
If Data.GetType Is GetType(RemoveFriend) Then Call RemoveFriendHandler(sender, CType(Data, RemoveFriend)) : Return
If Data.GetType Is GetType(User) Then Call UserHandler(sender, CType(Data, User)) : Return
If Data.GetType Is GetType(CreateGroup) Then Call CreateGroupHandler(sender, CType(Data, CreateGroup)) : Return
If Data.GetType Is GetType(GroupInfo) Then Call GroupInformationHandler(sender, CType(Data, GroupInfo)) : Return
If Data.GetType Is GetType(GroupInvitation) Then Call GroupInvitationHandler(sender, CType(Data, GroupInvitation)) : Return
If Data.GetType Is GetType(GroupMessage) Then Call GroupMessageHandler(sender, CType(Data, GroupMessage)) : Return
sender.Dispose()
End Sub
'''
''' Disposes of the TCPV2 Server.
'''
'''
Public Sub Dispose()
'Stop Listening for new connections.
ServerListener.Stop()
'Disconnect all users.
For i As Integer = m_Users.Count - 1 To 0 Step -1
'Tell them.
m_Users(i).SendMessage(New Message With {.Sender = "SERVER", .Message = "The Server is shutting down."})
'Dispose
m_Users(i).Dispose()
'Remove handlers
RemoveHandler m_Users(i).Message, AddressOf GeneralMessageHandler
RemoveHandler m_Users(i).ErrorOut, AddressOf ErrorHandler
'Remove from list.
m_Users.RemoveAt(i)
Next
'Raise message.
Me.OnMessageReceived(New MessageEventArgs With {.Message = "Server shutdown."})
End Sub
#End Region
#Region " Normal Handlers "
'''
''' The Registration Handler. It runs whenever registration attempts flow through the server.
'''
''' The Client sending the registration attempt.
''' The Registration information.
'''
Private Sub RegistrationHandler(ByVal sender As Client, ByVal registration As Register)
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Registration attempt with username '{0}' and password '{1}'.", registration.User, registration.Pass))})
If (registration.User <> String.Empty) AndAlso
(registration.User <> "SERVER") AndAlso
(registration.Pass <> String.Empty) AndAlso
Not UserExists(registration.User) Then
'All checks passed
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("All checks passed, clear for registration")})
'Store the details.
sender.Name = registration.User
sender.Password = registration.Pass()
sender.Status = "Online"
sender.Display = registration.User
'Save the user.
sender.SaveUser()
'Tell them everything checks out.
sender.SendMessage(New Message With {.Sender = "SERVER", .Message = "registered"})
Me.OnClientRegistration(New RegistrationEventArgs With {.Client = sender})
Else
'Check failed somewhere, oops
sender.SendMessage(New Message With {.Sender = "SERVER", .Message = "notregistered"})
End If
'Now that we're done, get rid of them.
sender.Dispose()
End Sub
'''
''' The Login Handler. It runs whenever a login attempt occurs and controls verification.
'''
''' The Client sending the request.
''' The Login information.
'''
Private Sub LoginHandler(ByVal sender As Client, ByVal login As Login)
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Login request.")})
'Check to see if they're NOT logged in and they exist.
If Not UserLoggedIn(login.User) AndAlso UserExists(login.User) Then
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Username '{0}' is registered, see if we supplied proper password.", login.User))})
'See if credientials are valid.
Select Case sender.LoadUser(login.User, login.Pass)
Case True
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("{0} successfully logged in!", sender.Name))})
sender.SendMessage(New Message With {.Sender = "SERVER", .Message = "loggedin"})
Me.OnClientLogin(New LoginEventArgs With {.Client = sender})
'Process the Queues
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Processing Queues for {0}", sender.Name))})
QueueList.EvaluateUserQueue(sender)
QueueList.EvaluateMessageQueue(sender)
QueueList.EvaluateRemoveQueue(sender)
'now tell all his friends.
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Queues Processed, send out notifications!"))})
Call LoginNotificationHandler(sender)
Case False
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Login failed. Notify the user. Invalid password.")})
sender.SendMessage(New Message With {.Sender = "SERVER", .Message = "invalid"})
sender.Dispose()
End Select
Else
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Login failed. Notify the user. Invalid username.")})
sender.SendMessage(New Message With {.Sender = "SERVER", .Message = "invalid"})
sender.Dispose()
End If
End Sub
'''
''' The LoginNotificationHandler tells everyone on the sender's friendlist that they are online.
'''
''' The Client that has logged in.
'''
Private Sub LoginNotificationHandler(ByVal sender As Client)
SyncLock sender.Friends
For i As Integer = sender.Friends.Count - 1 To 0 Step -1
'if the person is online...
Dim FriendName As String = sender.Friends(i).User
If UserLoggedIn(FriendName) Then
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("{0} is online, see if they are friends with {1} and viseversa.", FriendName, sender.Name))})
'Make the reference to them.
Dim Cli_Friend As Client = ReturnClient(FriendName)
'If the one we want to send the information to has them then tell them.
If Cli_Friend.IsUserInFriendList(sender.Name) Then
'Raise a log message.
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Telling {0} that {1} is online.", FriendName, sender.Name))})
'Tell the friend.
Cli_Friend.UpdateFriend(New User With {.User = sender.Name, .Status = sender.Status, .Online = True, .Display = sender.Display})
'Tell the sender.
sender.UpdateFriend(New User With {.User = Cli_Friend.Name, .Status = Cli_Friend.Status, .Online = True, .Display = Cli_Friend.Display})
End If
End If
Next
End SyncLock
End Sub
'''
''' The Message Handler. It will be processed ONLY if the sender is logged in.
'''
''' The client sending the Messages.
''' The Message data.
'''
Private Sub MessageHandler(ByVal sender As Client, ByVal message As Message)
If message.Receiver = "SERVER" Then
Call ServerProcessing(sender, message.Message.ToLower)
Return
End If
If (message.Sender <> String.Empty) AndAlso (sender.Name <> String.Empty) Then
message.Sender = sender.Name 'set the name
message.Display = sender.Display 'set the display
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Message from {0} to {1}.{2}Contents: {3}", sender.Name, message.Receiver, Environment.NewLine, message.Message))})
If UserLoggedIn(message.Receiver) Then
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("{0} was found, sending them a message.", message.Receiver))})
'Send them a message
ReturnClient(message.Receiver).SendMessage(message)
Else
'person isn't online, say they are offline.
sender.SendMessage(New Message With {.Sender = message.Receiver, .Message = "This user is currently offline and will receive your messages when they log back in.", .Display = message.Receiver})
'Add it to the message queue.
QueueList.AddOfflineMessage(message.Receiver, message)
End If
End If
End Sub
'''
''' Processes any messages meant for the Server.
'''
''' The client requesting the data.
''' The message.
'''
Private Sub ServerProcessing(ByVal sender As Client, ByVal message As String)
Select Case message
Case "loggedin" 'logging in.
sender.SendMessage(New User With {.User = sender.Name, .Status = sender.Status, .Online = True, .Display = sender.Display})
Case "groupdata" 'used for joining public groups
sender.SendMessage(CreatePublicGroupList)
End Select
End Sub
'''
''' The User Handler.
'''
''' The Client sending the Handler.
''' The User Data
'''
Private Sub UserHandler(ByVal sender As Client, ByVal User As User)
'See if it's about me.
If sender.Name = User.User Then
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("User Update. Old Status: {0}, New Status: {1}.{2}Old Display Name: {3}. New Display Name: {4}", sender.Status, User.Status, Environment.NewLine, sender.Display, User.Display))})
'it's just a status update, could also be a new display name
sender.Status = User.Status
sender.Display = User.Display
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Status was updated")})
'tell all his friends of the new status.
SyncLock sender.Friends
For Each userFriend As User In sender.Friends
If UserLoggedIn(userFriend.User) Then
'send out update.
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Sending update to '{0}'", userFriend.User))})
ReturnClient(userFriend.User).UpdateFriend(User)
End If
Next
End SyncLock
End If
End Sub
#End Region
#Region " Friend Handlers "
'''
''' Add a new Friend.
'''
''' The Client who's adding the friend.
''' The Friend information
'''
Private Sub AddFriendHandler(ByVal sender As Client, ByVal AddFriendInfo As AddFriend)
'First up, see if they're trying to add themselves..
If Not AddFriendInfo.User = sender.Name Then
'Look for the user.
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Incoming friend request from {0}", sender.Name))})
SyncLock sender.Friends
Try
If Not sender.IsUserInFriendList(AddFriendInfo.User) Then
'create the user data and pre-populate it.
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("{0} not found on {1}'s list, create some data.", AddFriendInfo.User, sender.Name))})
Dim NewUser As New User With {.User = AddFriendInfo.User, .Status = "Offline.", .Online = False}
'see if they're online.
If UserLoggedIn(AddFriendInfo.User) Then
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("{0} is also online. Let's tell them about the news.", AddFriendInfo.User))})
Call PopulateFriendData(NewUser)
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Add {0} to {1}'s list as well.", sender.Name, AddFriendInfo.User))})
ReturnClient(AddFriendInfo.User).AddFriend(New User With {.User = sender.Name, .Status = sender.Status, .Online = True, .Display = sender.Display})
Else
'Not online, add it to the item queue
QueueList.AddOfflineFriendRequest(AddFriendInfo.User, New User With {.Display = sender.Display, .Online = False, .Status = sender.Status, .User = sender.Name})
'Tell the person.
sender.SendMessage(New Message With {.Sender = "SERVER", .Message = String.Format("{0} was added to your friends list. They are currently offline and will appear when they login.", AddFriendInfo.User), .Receiver = sender.Name})
End If
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Update {0}'s friend list now.", sender.Name))})
sender.AddFriend(NewUser)
End If
Catch ex As Exception
Me.OnMessageReceived(New MessageEventArgs With {.Message = (ex.ToString)})
End Try
End SyncLock
End If
End Sub
'''
''' Populates a User Structure with Data.
'''
''' The User Structure to modify.
'''
Private Sub PopulateFriendData(ByRef Data As User)
If UserLoggedIn(Data.User) Then
Dim Client As Client = ReturnClient(Data.User)
Data.Online = True
Data.Display = Client.Display
Data.Status = Client.Status
End If
End Sub
'''
''' Remove a Friend from the Friends List.
'''
''' The Client to remove the friend from.
''' The friend to delete.
'''
Private Sub RemoveFriendHandler(ByVal sender As Client, ByVal DelFriendInfo As RemoveFriend)
'Remove from the sender.
sender.RemoveFriend(DelFriendInfo.m_Friend)
'Remove from the other if we can.
If UserLoggedIn(DelFriendInfo.m_Friend) Then
'logged in, remove it.
ReturnClient(DelFriendInfo.m_Friend).RemoveFriend(sender.Name)
Else
'not logged in, add it to queues.
QueueList.AddOfflineRemoveRequest(DelFriendInfo.m_Friend, sender.Name)
End If
End Sub
#End Region
#Region " Group Handlers "
Private Sub CreateGroupHandler(ByVal sender As Client, ByVal information As CreateGroup)
'See if a group chat exists
If Not GroupExists(information.GroupName) Then
'Group doesn't exist, create the group!
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Creating Group {0}, Admin: {1}", information.GroupName, information.Administrator))})
Dim Grp As New Group(information.GroupName, sender, information.IsPublic)
AddHandler Grp.Empty, AddressOf GroupEmpty
AddHandler Grp.Message, AddressOf GroupMessage
AddHandler Grp.Log, AddressOf GroupLog
m_GroupList.Add(Grp)
Me.OnGroupCreation(New GroupCreationEventArgs With {.Group = Grp})
Else
sender.SendMessage(New Message With {.Sender = "SERVER", .Receiver = sender.Name, .Message = String.Format("The Group '{0}' already exists.", information.GroupName)})
End If
End Sub
Private Sub GroupInformationHandler(ByVal sender As Client, ByVal information As GroupInfo)
'Break it down.
'first find the group
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Group Information Update from {0}", sender.Name))})
If GroupExists(information.GroupName) Then
'group found. use it.
Dim Grp As Group = ReturnGroup(information.GroupName)
'find the user. if found perform desired action.
If UserExists(information.User) AndAlso _
Not ReturnGroup(information.GroupName). _
IsUserInGroup(ReturnClient(information.User)) Then
Select Case information.Added
Case True 'add them into the group.
Grp.Add(ReturnClient(information.User))
Case False 'remove them from the group.
Grp.Remove(information.User)
End Select
End If
End If
End Sub
Private Sub GroupInvitationHandler(ByVal sender As Client, ByVal invitation As GroupInvitation)
If UserLoggedIn(invitation.invitee) Then
'find the user and send them the invite.
'But first make sure the group exists too.
If GroupExists(invitation.GroupName) Then
'Make sure they're not in the group.
If Not ReturnGroup(invitation.GroupName).IsUserInGroup(ReturnClient(invitation.invitee)) Then
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Inviting {0} to {1}. Invitation from {2}.", invitation.invitee, invitation.GroupName, invitation.sender))})
ReturnClient(invitation.invitee).SendMessage(invitation)
End If
End If
End If
End Sub
Private Sub GroupMessageHandler(ByVal sender As Client, ByVal message As GroupMessage)
'Find the group
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Message for Group {0} from {1}.{2}Contents: {3}", message.GroupName, sender.Name, Environment.NewLine, message.Message))})
If GroupExists(message.GroupName) Then
'send message.
Dim grp As Group = ReturnGroup(message.GroupName)
If grp.IsUserInGroup(sender) Then
grp.Send(grp.FindUser(sender), message.Message)
Else
sender.SendMessage(New GroupMessage With {.GroupName = message.GroupName, .Message = "You are not in this group!", .Sender = "SERVER"})
End If
End If
End Sub
'''
''' Occurs when a Group is removed.
'''
''' The Group being removed.
'''
Private Sub GroupEmpty(ByVal sender As Group)
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Group {0} is empty, removing from the Group List.", sender.Name))})
m_GroupList.Remove(sender)
End Sub
'''
''' Group Message Handler
'''
''' The Client sending the Message
''' The Message
''' The Group that the message was sent to
'''
Private Sub GroupMessage(ByVal sender As Client, ByVal message As String, ByVal grp As Group)
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Group Message. Group: {0}. Sender: {1}. Message: {2}", grp.Name, sender.Name, message)), .Type = MessageTypeEnum.Group})
End Sub
'''
''' Capture Group Log Messages.
'''
''' The log message.
'''
Private Sub GroupLog(ByVal log As String)
Me.OnMessageReceived(New MessageEventArgs With {.Message = (String.Format("Group Log: {0}", log))})
End Sub
'''
''' Quietly creates a list of all the public chat rooms.
'''
'''
'''
'''
Private ReadOnly Property CreatePublicGroupList() As ListOfGroups
Get
Dim GInfo As New List(Of CreateGroup)
SyncLock m_GroupList
For Each item As Group In m_GroupList
If item.IsPublic Then
GInfo.Add(New CreateGroup With {.Administrator = item.Admin.Name, .GroupName = item.Name, .IsPublic = True})
End If
Next
End SyncLock
Return New ListOfGroups With {.List = GInfo}
End Get
End Property
#End Region
#Region " Server Functions "
Private WithEvents GroupPurgeTimer As New System.Timers.Timer
'''
''' Find a User in the Data Directory. Returns a True if found and a false if not.
'''
''' The User to look for.
'''
'''
Public Function UserExists(ByVal user As String) As Boolean
Try
For Each file As String In IO.Directory.GetFiles(m_DataDirectory, "*.xml")
If IO.Path.GetFileNameWithoutExtension(file) = user Then Return True
Next
Catch ex As Exception
Debug.WriteLine(ex.ToString)
Return False
End Try
Return False
End Function
'''
''' See if a Client is online.
'''
''' The Client Name to look for.
'''
'''
Public Function UserLoggedIn(ByVal clientName As String) As Boolean
SyncLock m_Users
For Each Client As Client In m_Users
If Client.Name = clientName Then Return True
Next
Return False
End SyncLock
End Function
'''
''' Returns the reference point to the Client (if they are online).
'''
''' The name to use.
'''
'''
Public Function ReturnClient(ByVal clientName As String) As Client
SyncLock m_Users
For Each Client As Client In m_Users
If Client.Name = clientName Then Return Client
Next
Return Nothing
End SyncLock
End Function
'''
''' Locate a Group by it's name.
'''
''' The Group's Name.
'''
'''
Public Function GroupExists(ByVal name As String) As Boolean
SyncLock m_GroupList
For Each item As Group In m_GroupList
If item.Name = name Then Return True
Next
Return False
End SyncLock
End Function
'''
''' Find a Group based on it's name and open it up for manipulation.
'''
''' The name of the group.
'''
'''
Public Function ReturnGroup(ByVal name As String) As Group
SyncLock m_GroupList
For Each item As Group In m_GroupList
If item.Name = name Then Return item
Next
Return Nothing
End SyncLock
End Function
Private Sub GroupPurgeTimer_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles GroupPurgeTimer.Elapsed
If m_GroupList.Count > 0 Then
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Group Purge starting.")})
For i As Integer = m_GroupList.Count - 1 To 0 Step -1
If m_GroupList(i).Group.Count = 0 Then m_GroupList.RemoveAt(i)
Next
Me.OnMessageReceived(New MessageEventArgs With {.Message = ("Group Purging complete.")})
End If
End Sub
'''
''' Removes a Group from the GroupList.
'''
''' The Group to remove.
'''
Public Sub RemoveGroup(ByVal grp As Group)
m_GroupList.Remove(grp)
End Sub
#End Region
End Class