modsocket.vb.svn-base

MirUnleashed vb.net Module modMainServer Public WithEvents Socket As New WinsockServer Pub

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

Module modSocket
    Public QueueThread As New Threading.Thread(AddressOf Socket.ProcessQueue)
    Dim MaxPacketSize As Integer = 10240

    Public Class State
        Public WSocket As Socket = Nothing
        Public Buffer() As Byte
        Public Tag As String
        Public Index As Integer
        Public CanLogin As Boolean = False
        Public ConnectionTime As String
        Public Sending As Boolean = False
        Public QueueItem(32767) As String
        Public QueueCount As Integer = 0
    End Class

    Public Class WinsockServer
        Public Event onDataArrival(ByVal Data() As Byte, ByVal State As State)
        Public Event onAccept(ByVal State As State)
        Public Event onError(ByVal Err As String, ByVal State As State)
        Public Event onDisconnect(ByVal State As State)
        Public Event onSend(ByVal Data As String)
        Public Event onSendComplete(ByVal State As State)

        Private Index As Integer = -1
        Public Lst As New List

        Sub Listen(ByVal Port As Integer)
            Dim s As New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp)

            Dim lep As System.Net.IPEndPoint
            Dim IP As System.Net.IPAddress
            Dim tIP As String

            tIP = Config.GameIP
            IP = IP.Parse(tIP)
            lep = New System.Net.IPEndPoint(IP, Port)
            s = New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp)

            Try
                With s
                    .Bind(lep)
                    .Listen(1000)
                    .BeginAccept(New AsyncCallback(AddressOf Accept), s)
                End With

            Catch ex As Exception

            End Try

            If Config.GameIP = "127.0.0.1" Then
                GoTo EndOfThis
            End If
            IP = IP.Parse("127.0.0.1")
            lep = New System.Net.IPEndPoint(IP, Port)
            s = New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp)

            Try
                With s
                    .Bind(lep)
                    .Listen(1000)
                    .BeginAccept(New AsyncCallback(AddressOf Accept), s)
                End With

                'QueueThread.IsBackground = True
                'QueueThread.Priority = Threading.ThreadPriority.Normal
                'QueueThread.Start()

            Catch ex As Exception

            End Try
EndOfThis:

            'addlog("listen()", "Socket started")
        End Sub

        Sub SendData(ByVal Data As String, ByVal Ind As Long)
            'addlog("senddata()", "Data out: " & data)
            Dim So As State
            Try
                Dim bData() As Byte = ASCII.GetBytes(Data)
                If bData.Length - 1 > MaxPacketSize Then MsgBox("Error")
                So = Lst.Item(Ind)
                'If So.Sending Then
                '    AddToQueue(Data, So)
                'Else
                So.Sending = True

                'So.WSocket.Send(bData)
                So.WSocket.Blocking = False
                So.WSocket.BeginSend(bData, 0, bData.Length, 0, New AsyncCallback(AddressOf SendComplete), So)
                RaiseEvent onSend(Data)
                'End If
            Catch Ex As Exception
                RaiseEvent onError(Ex.ToString, So)
            End Try
        End Sub

        Sub SendDataNow(ByVal Data As String, ByVal Ind As Long)
            'addlog("senddata()", "Data out: " & data)
            Dim So As State
            Try
                Dim bData() As Byte = ASCII.GetBytes(Data)
                If bData.Length - 1 > MaxPacketSize Then MsgBox("Error")
                So = Lst.Item(Ind)
                So.Sending = True

                'So.WSocket.Send(bData)
                So.WSocket.BeginSend(bData, 0, bData.Length, 0, New AsyncCallback(AddressOf SendComplete), So)
                RaiseEvent onSend(Data)
            Catch Ex As Exception
                RaiseEvent onError(Ex.ToString, So)
            End Try
        End Sub

        Private Sub Accept(ByVal ar As IAsyncResult)
            Dim s As Socket = CType(ar.AsyncState, Socket)
            Dim ss As Socket

            Dim State As New State
            Try
                Index = Index + 1
                ss = s.EndAccept(ar)
                State.WSocket = ss
                'State.WSocket.Blocking = False
                State.Index = Lst.Add(State, GetTok(ss.RemoteEndPoint.ToString(), 0, ":"))
                ReDim State.Buffer(MaxPacketSize)
                s.BeginAccept(New AsyncCallback(AddressOf Accept), s)
                ss.BeginReceive(State.Buffer, 0, MaxPacketSize, SocketFlags.None, New AsyncCallback(AddressOf Recieve), State)
                'addlog("Accepted socket connection: " & ss.RemoteEndPoint.ToString, True)
            Catch ex As Exception
                RaiseEvent onError(ex.ToString(), State)
            End Try
            RaiseEvent onAccept(State)

        End Sub

        Private Sub Recieve(ByVal ar As IAsyncResult)
            Dim State As State = CType(ar.AsyncState, State)
            Dim Bytes As Integer = Nothing
            Dim Data() As Byte = Nothing

            Try
                Bytes = State.WSocket.EndReceive(ar)
            Catch ex As Exception
                RaiseEvent onError(ex.ToString, State)
            End Try

            ReDim Preserve State.Buffer(Bytes - 1)
            ReDim Preserve State.Buffer(MaxPacketSize)
            Data = State.Buffer
            If Bytes = 0 Then
                Try 'if the received info is 0 close the socket
                    State.WSocket.Shutdown(SocketShutdown.Both)
                    State.WSocket.Close()
                    Index = Index - 1
                    RaiseEvent onDisconnect(State)
                    'lst.remove(state.index)

                    Exit Sub
                Catch ex As Exception
                    RaiseEvent onError(ex.ToString(), State)
                End Try
            End If
            Try
                State.WSocket.BeginReceive(State.Buffer, 0, MaxPacketSize, SocketFlags.None, New AsyncCallback(AddressOf Recieve), State)
            Catch ex As Exception
                'RaiseEvent onDisconnect(State) 'Tell the server the player has disconnected
                'RaiseEvent onError(ex.ToString)
            End Try
            'addlog("recieve()", "DataIn: " & System.Text.Encoding.ASCII.GetString(data))
            RaiseEvent onDataArrival(Data, State)
        End Sub

        Private Sub AddToQueue(ByVal Data As String, ByVal State As State)
            State.QueueCount += 1
            State.QueueItem(State.QueueCount - 1) = Data
        End Sub

        Public Sub ProcessQueue()
            Do Until UserCount < 0
                If Not UserCount = 0 Then

                    Dim i As Integer

                    For i = 0 To 32767 - 1
                        Dim State As State = Lst.Item(i)

                        If Not State Is Nothing Then
                            If State.QueueCount <> 0 Then
                                If Not State.Sending Then
                                    SendDataNow(State.QueueItem(State.QueueCount - 1), State.Index)
                                    UpdateQueue(State)
                                End If
                            End If
                        End If
                    Next i

                End If
                QueueThread.Sleep(200)
            Loop
        End Sub

        Private Sub UpdateQueue(ByVal State As State)
            Dim i As Integer

            State.QueueCount -= 1
            For i = 0 To 32767 - 1
                If Not State.QueueItem(i + 1) Is Nothing Then
                    State.QueueItem(i) = State.QueueItem(i + 1)
                End If
            Next i
        End Sub

        Private Sub SendComplete(ByVal ar As IAsyncResult)
            Dim State As State = CType(ar.AsyncState, State)
            Dim DataSize As Integer = State.WSocket.EndSend(ar)

            State.Sending = False
            RaiseEvent onSendComplete(State)

            'Console.WriteLine("Sent to Socket: " & m_SocketID & " = Data Size: " & send)

        End Sub

        Sub EndConn(ByVal Ind As Long)
            Dim Stat As State
            Stat = Lst.Item(Ind)
            If Stat Is Nothing Or Stat.WSocket.Connected = False Then
            Else
                'addlog(lst.getcharacter(ind) & " Disconnected", True)
                Stat.WSocket.Shutdown(SocketShutdown.Both)
                Stat.WSocket.Close()
                RaiseEvent onDisconnect(Stat)
            End If
        End Sub

        Sub DisconnectUser(ByVal Ind As Long)
            Dim Stat As State
            Stat = Lst.Item(Ind)
            If Stat Is Nothing Then
            Else
                'addlog(lst.getcharacter(ind) & " Disconnected", True)
                'stat.WSocket.Shutdown(SocketShutdown.Both)
                Stat.WSocket.Close()
                RaiseEvent onDisconnect(Stat)
            End If
        End Sub

        Sub DisconnectBannedUser(ByVal Ind As Long)
            Dim Stat As State
            Stat = Lst.Item(Ind)
            If Stat Is Nothing Then
            Else
                'addlog(lst.getcharacter(ind) & " Disconnected", True)
                'stat.WSocket.Shutdown(SocketShutdown.Both)
                Stat.WSocket.Close()
            End If
        End Sub

        Public Sub SplitDataSend(ByVal Packet As String, ByVal State As State)
            RaiseEvent onDataArrival(System.Text.Encoding.ASCII.GetBytes(Packet), State)
        End Sub
    End Class

    Public Class List 'This would contain the list of socket connections and assoicated stuff
        Private Structure ListType
            Dim State As State
            Dim Login As String 'This would contain the login associated with this socket
            Dim Character As String 'This would contain the char associated with this socket
            Dim IP As String 'IP this socket is connected to
        End Structure
        Private Lst(32767) As List.ListType 'Could be this takes 32767 possible sockets not sure
        Private Index As Integer = -1

        Public Function Add(ByVal value As State, Optional ByVal ip As String = "") As Long 'Add a new socket connection
            If Index = -1 Then 'If there are no other connections
                Index = Index + 1
                Lst(Index).State = value
                Lst(Index).Login = ""
                Lst(Index).Character = ""
                Lst(Index).IP = ip
                Add = Index
            Else 'find an empty connection to start
                Dim i As Integer
                Dim a As Integer = -1
                For i = 0 To Index 'from 0 to the last socket that got oppened
                    If Lst(i).State Is Nothing Then 'if the socket isnt connected
                        a = i 'set the a to the first available socket position
                        Exit For
                    End If
                Next i
                If a = -1 Then 'if there's no position available before the index use index
                    Index = Index + 1
                    Lst(Index).State = value
                    Lst(Index).Login = ""
                    Lst(Index).Character = ""
                    Lst(Index).IP = ip
                    Add = Index
                Else 'if there's a free position before index use the free position
                    Lst(a).State = value
                    Lst(a).Login = ""
                    Lst(a).Character = ""
                    Lst(a).IP = ip
                    Add = a
                End If
            End If
        End Function

        Public Function Count() As Long
            Count = Index + 1 'Return the amount of sockets that are currently used
        End Function

        Public Function Remove(ByVal Index2 As Integer) As Long
            Lst(Index2).State = Nothing
            Lst(Index2).Login = ""
            Lst(Index2).Character = ""
            Lst(Index2).IP = ""
            Index = Index - 1
        End Function

        Public Function Item(ByVal Index2 As Integer) As State
            Item = Lst(Index2).State
        End Function

        Public Function GetLogin(ByVal Index2 As Integer) As String
            Return Lst(Index2).Login
        End Function
        Public Function GetCharacter(ByVal Index2 As Integer) As String
            Return Lst(Index2).Character
        End Function
        Public Function GetIP(ByVal Index2 As Integer) As String
            Return Lst(Index2).IP
        End Function

        Public Sub SetLogin(ByVal Index2 As Integer, ByVal login As String)
            Lst(Index2).Login = login
        End Sub
        Public Sub SetCharacter(ByVal Index2 As Integer, ByVal character As String)
            Lst(Index2).Character = character
        End Sub
    End Class
End Module