[Improvement] Player Update - Printable Version

Code:

Public Sub ServerLoop()

Dim i As Long

Dim x As Long

Dim y As Long



Dim Tick As Long



Dim tmr500 As Long

Dim tmr1000 As Long



Dim LastUpdateMapSpawnItems As Long



    ServerOnline = True

    

    Do While ServerOnline

        Tick = GetTickCount

        

        If Tick > tmr500 Then

            ' Check for disconnections

            For i = 1 To MAX_PLAYERS

                If frmServer.Socket(i).State > sckConnected Then

                    Call CloseSocket(i)

                End If

                

                ' Update the player

                If IsPlaying(i) Then

                    OnUpdate i

                End If

            Next

            

            ' Process NPC AI

            UpdateNpcAI

           

            tmr500 = GetTickCount + 500

        End If

        

        If Tick > tmr1000 Then

            ' Handle shutting down server

            If isShuttingDown Then

                Call HandleShutdown

            End If

            

            ' Handles closing doors

            For i = 1 To MAX_MAPS

                If Tick > TempTile(i).DoorTimer + 5000 Then

                    For x = 0 To MAX_MAPX

                        For y = 0 To MAX_MAPY

                            If Map(i).Tile(x, y).Type = TILE_TYPE_KEY Then

                                If TempTile(i).DoorOpen(x, y) = YES Then

                                    TempTile(i).DoorOpen(x, y) = NO

                                    Call SendDataToMap(i, SMapKey & SEP_CHAR & x & SEP_CHAR & y & SEP_CHAR & 0 & END_CHAR)

                                End If

                            End If

                        Next

                    Next

                End If

            Next

            

            tmr1000 = GetTickCount + 1000

        End If

        

        ' Checks to spawn map items every 5 minutes - Can be tweaked

        If Tick > LastUpdateMapSpawnItems Then

            UpdateMapSpawnItems

            LastUpdateMapSpawnItems = GetTickCount + 300000

        End If

        

        Sleep 1

        DoEvents

    Loop

End Sub

Code:

''***************************************

' Events for updating

'***************************************

Sub OnUpdate(ByVal Index As Long)

Dim i As Long

    

    '*****************************

    '**  Checks to save player  **

    '*****************************

    If GetTickCount > TempPlayer(Index).LastUpdateSave Then

        SavePlayer Index

        TempPlayer(Index).LastUpdateSave = GetTickCount + 600000    ' 10 minutes

    End If

           

    '**************************************

    '**  Checks to update player vitals  **

    '**************************************

    If GetTickCount > TempPlayer(Index).LastUpdateVitals Then

        For i = 1 To Vitals.Vital_Count - 1

            If GetPlayerVital(Index, i)  GetPlayerMaxVital(Index, i) Then

                Call SetPlayerVital(Index, i, GetPlayerVital(Index, i) + GetPlayerVitalRegen(Index, i))

                Call SendVital(Index, i)

            End If

        Next

        TempPlayer(Index).LastUpdateVitals = GetTickCount + 5000   ' 5 seconds

    End If

End Sub