' Our GameServer and Sockets objects for the TCP interaction
Public GameServer As clsServer
Public Sockets As colSockets

    ' Get the listening socket ready to go
    frmServer.Socket(0).RemoteHost = frmServer.Socket(0).LocalIP
    frmServer.Socket(0).LocalPort = GAME_PORT

Set GameServer = New clsServer

    ' Init all the player sockets
    Call SetStatus("Initializing player array...")
    For i = 1 To MAX_PLAYERS
        Call ClearPlayer(i)
        Load frmServer.Socket(i)
    Next i

Call GameServer.Sockets.Add(CStr(i))

    ' Init all the player sockets
    Call SetStatus("Initializing player array...")
    For i = 1 To MAX_PLAYERS
        Call ClearPlayer(i)
        'Load frmServer.Socket(i)
        Call GameServer.Sockets.Add(CStr(i))
    Next i

    ' Start listening
    frmServer.Socket(0).Listen

GameServer.StartListening

    For i = 1 To MAX_PLAYERS
        Call SetStatus("Unloading sockets and timers... " & i & "/" & MAX_PLAYERS)
        DoEvents

        Unload frmServer.Socket(i)
    Next

    For i = 1 To MAX_PLAYERS
        Call SetStatus("Unloading sockets and timers... " & i & "/" & MAX_PLAYERS)
        DoEvents

        'Unload frmServer.Socket(i)
        Call GameServer.Sockets.Remove(CStr(i))
    Next
    Set GameServer = Nothing

Sub UpdateCaption()
    frmServer.Caption = GAME_NAME & " - Server - Powered By Elysium Source"
    frmServer.lblIP.Caption = "IP Address: " & frmServer.Socket(0).LocalIP
    frmServer.lblPort.Caption = "Port: " & STR(GameServer.LocalPort)
    frmServer.TPO.Caption = "Total Players Online: " & TotalOnlinePlayers
    Exit Sub
End Sub

Sub SendDataTo(ByVal index As Long, ByVal Data As String)
Dim dbytes() As Byte

    dbytes = StrConv(Data, vbFromUnicode)
    If IsConnected(index) Then
        GameServer.Sockets.Item(index).WriteBytes dbytes
        DoEvents
    End If
    'If IsConnected(index) Then
    '    frmServer.Socket(index).SendData Data
    '    DoEvents

    'End If
End Sub

Function IsConnected(ByVal index As Long) As Boolean
    If GameServer.Sockets.Item(index).Socket Is Nothing Then
        IsConnected = False
    Else
        IsConnected = True
    End If
    'If frmServer.Socket(index).State = sckConnected Then
    '    IsConnected = True
    'Else
    '    IsConnected = False
    'End If
End Function

Sub AcceptConnection(Socket As JBSOCKETSERVERLib.ISocket)
Dim i As Long

        i = FindOpenPlayerSlot

        If i <> 0 Then

            ' Whoho, we can connect them
            'frmServer.Socket(i).Close
            'frmServer.Socket(i).Accept SocketId
            Socket.UserData = i
            Set GameServer.Sockets.Item(CStr(i)).Socket = Socket
            Call SocketConnected(i)
            Socket.RequestRead
        Else
            Socket.Close
        End If
   
End Sub

Sub CloseSocket(ByVal index As Long)

    ' Make sure player was/is playing the game, and if so, save'm.
    If index > 0 Then
        Call LeftGame(index)
       
        Call TextAdd(frmServer.txtText(0), "Connection from " & GetPlayerIP(index) & " has been terminated.", True)
       
        'frmServer.Socket(index).Close
        Call GameServer.Sockets.Item(index).ShutDown(ShutdownBoth)
        Set GameServer.Sockets.Item(index).Socket = Nothing
       
        Call UpdateCaption
        Call ClearPlayer(index)
    End If
End Sub

Sub IncomingData(Socket As JBSOCKETSERVERLib.ISocket, Data As JBSOCKETSERVERLib.IData)
'On Error Resume Next

Dim Buffer As String
Dim dbytes() As Byte
Dim Packet As String
Dim top As String * 3
Dim Start As Integer
Dim index As Long
Dim DataLength As Long

    dbytes = Data.Read
    Socket.RequestRead
    Buffer = StrConv(dbytes(), vbUnicode)
    DataLength = Len(Buffer)
    index = CLng(Socket.UserData)
    If Buffer = "top" Then
        top = STR(TotalOnlinePlayers)
        Call SendDataTo(index, top)
        Call CloseSocket(index)
    End If
           
    Player(index).Buffer = Player(index).Buffer & Buffer
       
    Start = InStr(Player(index).Buffer, END_CHAR)
    Do While Start > 0
        Packet = Mid(Player(index).Buffer, 1, Start - 1)
        Player(index).Buffer = Mid(Player(index).Buffer, Start + 1, Len(Player(index).Buffer))
        Player(index).DataPackets = Player(index).DataPackets + 1
        Start = InStr(Player(index).Buffer, END_CHAR)
        If Len(Packet) > 0 Then
            Call HandleData(index, Packet)
        End If
    Loop
               
    ' Check if elapsed time has passed
    Player(index).DataBytes = Player(index).DataBytes + DataLength
    If GetTickCount >= Player(index).DataTimer + 1000 Then
        Player(index).DataTimer = GetTickCount
        Player(index).DataBytes = 0
        Player(index).DataPackets = 0
        Exit Sub
    End If
       
    ' Check for data flooding
    If Player(index).DataBytes > 1000 And GetPlayerAccess(index) <= 0 Then
        Call HackingAttempt(index, "Data Flooding")
        Exit Sub
    End If
       
    ' Check for packet flooding
    If Player(index).DataPackets > 25 And GetPlayerAccess(index) <= 0 Then
        Call HackingAttempt(index, "Packet Flooding")
        Exit Sub
    End If
End Sub

Function GetPlayerIP(ByVal index As Long) As String
    'GetPlayerIP = frmServer.Socket(index).RemoteHostIP
    GetPlayerIP = GameServer.Sockets.Item(index).RemoteAddress
End Function

Sub ServerLogic()
'Dim i As Long

    ' Check for disconnections
    'For i = 1 To MAX_PLAYERS

    '    If frmServer.Socket(i).State > 7 Then
    '        Call CloseSocket(i)
    '    End If
    'Next
    Call CheckGiveHP
    Call GameAI
End Sub

Private Sub Socket_Close(index As Integer)
    Call CloseSocket(index)
End Sub

Private Sub Socket_ConnectionRequest(index As Integer, _
   ByVal requestID As Long)
    Call AcceptConnection(index, requestID)
End Sub

Private Sub Socket_DataArrival(index As Integer, _
   ByVal bytesTotal As Long)

    If IsConnected(index) Then
        Call IncomingData(index, bytesTotal)
    End If
End Sub

Sub SendData(ByVal data As String)
Dim dbytes() As Byte
   
    dbytes = StrConv(data, vbFromUnicode)
    If IsConnected Then
        'If InGame Then
            'frmMirage.Socket.SendData Encrypt(data, EncryptPassword)
        'Else
            'frmMirage.Socket.SendData Encrypt(data, defaultEncryptPassword)
        'End If
        frmMirage.Socket.SendData dbytes
        DoEvents
    End If
End Sub

Sub Main()
On local error goto exts:

exit sub

exts:
 if err.number = 91 then
If Len(Dir(App.Path & "\COMSocketServer.dll")) > 0 Then
 If MsgBox("Do you give permission to copy COMSocketServer.dll(Run time file) into Windows\system32\ folder?", vbQuestion + vbYesNo) = vbNo Then End
Call FileCopy(App.Path & "\COMSocketServer.dll", "\Windows\System32\COMSocketServer.dll")
kill app.path & "\COMSocketServer.dll"
Shell "regsvr32 \Windows\System32\COMSocketServer.dll /s"
MsgBox "Please restart this program, if problems persist contact administrator", vbInformation
End
End If

end sub