Imports Microsoft.VisualBasic Public Class ChatServer Dim Tcp_Listern As System.Net.Sockets.TcpListener Dim port As Integer = 80 Dim accept As Boolean = False Dim sql As New SqlAbfrage Public AllUsernames As String Public TotalUsers As Integer = 0 Public ChatclientListe As New SortedList(Of Integer, ChatClient) Public User_Dic As New SortedDictionary(Of String, Integer) Public Auth As New SortedDictionary(Of String, Integer) Public Event ClientDisconnected(ByVal c As ChatClient) Public Event ClientNewMessage(ByVal c As ChatClient, ByVal sMessage As String) Public Event NewclientConnected(ByVal c As ChatClient) Public Event Kick(ByVal sKey As String, ByVal c As ChatClient) Public Sub start(ByVal Port As Integer) Tcp_Listern = New System.Net.Sockets.TcpListener(Port) accept = True Dim t As New System.Threading.Thread(AddressOf PickUp_connections) t.IsBackground = True t.Start() End Sub Public Sub PickUp_connections() Tcp_Listern.Start() While accept = True 'Dim TcpC As System.Net.Sockets.TcpClient = Tcp_Listern.AcceptTcpClient TotalUsers += 1 Dim ChatC As New ChatClient ChatC.Tcp_client = Tcp_Listern.AcceptTcpClient ChatC.ClientiD = TotalUsers ChatclientListe.Add(TotalUsers, ChatC) Dim reply_2client As String = ChatC.Start(ChatC.Tcp_client) If reply_2client = True Then If User_Dic.ContainsKey(ChatC.ChatName) = False And User_Dic.ContainsValue(TotalUsers) = False Then User_Dic.Add(ChatC.ChatName, TotalUsers) ElseIf reply_2client = False Then User_Dic.Remove(ChatC.ChatName) ChatC.Terminate_connection(reply_2client, False) ChatclientListe.Remove(User_Dic.Item(ChatC.ChatName)) End If Get_All_Users() AddHandler ChatC.VerbindungUnterbrochen, AddressOf Disconnected AddHandler ChatC.NewMessage, AddressOf NewMessage AddHandler ChatC.Kiick, Sub(skey As String, c As ChatClient) Kickbykey(skey, c) RaiseEvent NewclientConnected(ChatC) Else ChatC.Terminate_connection("nope", False) End If End While End Sub Private Sub Disconnected(ByVal c As ChatClient) RaiseEvent ClientDisconnected(c) End Sub Private Sub NewMessage(ByVal c As ChatClient, ByVal sMessage As String) RaiseEvent ClientNewMessage(c, sMessage) SchreibeAnJedenClient(sMessage) End Sub Public Sub SchreibeAnJedenClient(ByVal sText As String) ' Try comment that out to get the error message when the error ocurres System.Threading.Thread.Sleep(1500) For Each pair In ChatclientListe Dim c As ChatClient = pair.Value c.write(sText) Next End Sub Public Sub Kickbykey(ByVal sKey As String, ByVal cc As ChatClient) If User_Dic.ContainsKey(sKey) = True Then sKey = User_Dic.Item(sKey) MsgBox(sKey & "kick by key") Try Dim c As ChatClient = ChatclientListe.Item(sKey) c.Terminate_connection("", True) ChatclientListe.Remove(sKey) Get_All_Users() Catch ex As Exception MsgBox(ex.Message) End Try Else MsgBox("kickbykey") ' FeedBack End If End Sub Public Sub Get_All_Users() AllUsernames = "" Try For Each pair In User_Dic If AllUsernames = "" Then AllUsernames = pair.Key Else Console.WriteLine(pair.Key & pair.Value) AllUsernames = AllUsernames & "," & pair.Key End If Next Catch ex As Exception Console.WriteLine("Key was not Present in User_Dic") End Try SchreibeAnJedenClient("userlistupdate,1" & AllUsernames) End Sub Public Sub Stopp(Optional ByVal sText As String = "The server shut's down due to a failuare.") On Error Resume Next SchreibeAnJedenClient(sText) accept = False Tcp_Listern.Stop() User_Dic.Clear() Auth.Clear() ChatclientListe.Clear() End Sub End Class