Upgrade 1.0.7 to 1.0.8

From VbGORE Visual Basic Online RPG Engine

Contents 1 Add - Better disconnection checking 2 Fix - frmNewProc 3 Fix - GOREsockServer MaxConnectionsPerIP 4 Fix - User_WarpChar crash 5 Fix - Server_LegalPos NPCIndex crash 6 Fix - GOREsockServer 7 Fix - /who crashing 8 Fix - Connect screen CPU usage 9 Fix - Object only quests message

This guide will lead you through how to upgrade Version 1.0.7 to Version 1.0.8. For help, please refer to the How to upgrade article. It is highly recommended you read it before ever upgrading.

Add - Better disconnection checking

Open GameServer.vbp.

Find:

<vb>

   Server_ChangeCharType As Byte

</vb>

After, add:

<vb>

   Server_KeepAlive As Byte

</vb>

Find:

<vb>

       .GM_BanList = 120

</vb>

After, add:

<vb>

       .Server_KeepAlive = 121

</vb>

Find:

<vb> Private Const UpdateRate_KeepAlive As Long = 600000 'Sends a misc query to the database to keep the connection alive since connection dies after a while </vb>

After, add:

<vb> Private Const UpdateRate_KeepAliveClient As Long = 3000 'sends a "keep alive" packet to the client to let them know the connection is still made with the server </vb>

Find:

<vb> Public DebugPacketsIn() As Long </vb>

After, add:

<vb> 'Keep alive packet Public KeepAlivePacket() As Byte </vb>

Find:

<vb>

   '*** Build cached messages ***

</vb>

Before, add:

<vb>

   '*** Build client keep-alive packet ***
   
   ConBuf.Clear
   ConBuf.Put_Byte DataCode.Server_KeepAlive
   KeepAlivePacket = ConBuf.Get_Buffer

</vb>

Find:

<vb>

   HasBuffer As Byte       'If there is anything in the buffer

</vb>

After, add:

<vb>

   LastPacketSent as Long  'Time the last packet was sent

</vb>

Find:

<vb>

           UserList(UserIndex).PacketWait = 0

</vb>

After, add:

<vb>

           'Store the time at which the packet was sent
           UserList(UserIndex).LastPacketSent = timeGetTime

</vb>

Find:

<vb>

               'Check if the packet wait time has passed

</vb>

Before, add:

<vb>

               'Check if a keep-alive packet needs to be sent
               If UserList(UserIndex).HasBuffer = 0 Then   'Don't add the keep-alive to a user already with a buffer
                   If timeGetTime - UserList(UserIndex).LastPacketSent > UpdateRate_KeepAliveClient Then   'Check if enough time has elapsed
                       
                       'Add the keep-alive packet to the user's buffer
                       Data_Send ToIndex, UserIndex, KeepAlivePacket()
                       
                   End If
               End If

</vb>

Open GameClient.vbp.

Find:

<vb> 'If there is a clear path to the target (if any) </vb>

Before, add:

<vb> 'The time the last packet from the server arrived Public LastServerPacketTime As Long </vb>

Find:

<vb>

       'Send the data buffer
       If SocketOpen Then Data_Send

</vb>

Replace with:

<vb>

       'Perform the following only if the connection to the server is open
       If SocketOpen Then
           
           'Send the data buffer
           Data_Send
           
           'Check the time since the last packet arrived
           If timeGetTime - LastServerPacketTime > 6000 Then
           
               'No response from the server in 6 seconds, must be disconnected :(
               IsUnloading = 1
               
           End If
           
       End If

</vb>

Find:

<vb>

   BufUBound = UBound(inData)

</vb>

After, add:

<vb>

   'Packet arrived!
   LastServerPacketTime = timeGetTime

</vb>

Fix - frmNewProc

Open GameClient.vbp.

Find:

<vb>

           Case frmNew.BodyCmb.hwnd
               With frmNew.ClassCmb
                   SetBkMode wParam, 1
                   BitBlt wParam, 0, 0, .Width, .Height, frmNew.hDC, .Left, .Top, vbSrcCopy
               End With
               
           Case frmNew.HeadCmb.hwnd
               With frmNew.ClassCmb
                   SetBkMode wParam, 1
                   BitBlt wParam, 0, 0, .Width, .Height, frmNew.hDC, .Left, .Top, vbSrcCopy
               End With

</vb>

Replace with:

<vb>

           Case frmNew.BodyCmb.hwnd
               With frmNew.BodyCmb
                   SetBkMode wParam, 1
                   BitBlt wParam, 0, 0, .Width, .Height, frmNew.hDC, .Left, .Top, vbSrcCopy
               End With
               
           Case frmNew.HeadCmb.hwnd
               With frmNew.HeadCmb
                   SetBkMode wParam, 1
                   BitBlt wParam, 0, 0, .Width, .Height, frmNew.hDC, .Left, .Top, vbSrcCopy
               End With

</vb>

Fix - GOREsockServer MaxConnectionsPerIP

Replace the GOREsockServer.ocx with the one found in v1.0.8. When adding the new control, GameServer.vbp, when loaded, will most likely complain about it not being found. In this case, delete the control from the form, remove the reference (Ctrl + T, untick the box if it is there, but most likely is not), click Browse, select GOREsockServer.ocx, add the control back onto the form and rename it back to GOREsock.

Fix - User_WarpChar crash

Open GameServer.vbp.

Find:

<vb> Public Sub User_WarpChar(ByVal UserIndex As Integer, ByVal Map As Integer, ByVal X As Integer, ByVal Y As Integer, Optional ByVal ForceSwitch As Boolean = False) </vb>

Replace the whole sub with:

<vb> Public Sub User_WarpChar(ByVal UserIndex As Integer, ByVal Map As Integer, ByVal X As Integer, ByVal Y As Integer, Optional ByVal ForceSwitch As Boolean = False)

'***************************************************************** 'Warps user to another spot '***************************************************************** Dim CorrectServer As Byte Dim OldMap As Integer Dim LoopC As Long

   Log "Call User_WarpChar(" & UserIndex & "," & Map & "," & X & "," & Y & "," & ForceSwitch & ")", CodeTracker '//\\LOGLINE//\\

   OldMap = UserList(UserIndex).Pos.Map

   If OldMap <= 0 Then
       Log "User_WarpChar: OldMap <= 0", CodeTracker '//\\LOGLINE//\\
       Exit Sub
   End If
   If OldMap > NumMaps Then
       Log "User_WarpChar: OldMap > NumMaps", CodeTracker '//\\LOGLINE//\\
       Exit Sub
   End If
   
   'Clear the pending quest NPC number and trading NPC, along with speedhack flags
   UserList(UserIndex).Flags.QuestNPC = 0
   UserList(UserIndex).Flags.TradeWithNPC = 0
   UserList(UserIndex).Flags.StepCounter = 0
   UserList(UserIndex).Counters.MoveCounter = timeGetTime
   UserList(UserIndex).Counters.StepsRan = 0

   If (OldMap <> Map) Or ForceSwitch = True Then
       Log "User_WarpChar: Switching maps", CodeTracker '//\\LOGLINE//\\
       
       'Set the new position
       User_EraseChar UserIndex
       UserList(UserIndex).Pos.X = X
       UserList(UserIndex).Pos.Y = Y
       UserList(UserIndex).Pos.Map = Map
       
       'Check if the user is on the correct server, or needs to be switched
       CorrectServer = User_CorrectServer(UserList(UserIndex).Name, UserIndex, Map)
       
       'Check if it's the first user on the map and is the correct server
       If CorrectServer = 1 Then
           MapInfo(Map).NumUsers = MapInfo(Map).NumUsers + 1
           If MapInfo(Map).NumUsers = 1 Then
               Load_Maps_Temp Map
               ReDim MapUsers(Map).Index(1 To 1)
           Else
               ReDim Preserve MapUsers(Map).Index(1 To MapInfo(Map).NumUsers)
           End If
           MapUsers(Map).Index(MapInfo(Map).NumUsers) = UserIndex
       End If
       
       'Update old Map Users
       MapInfo(OldMap).NumUsers = MapInfo(OldMap).NumUsers - 1
       If MapInfo(OldMap).NumUsers Then
           'Find current pos within connection group
           For LoopC = 1 To MapInfo(OldMap).NumUsers + 1
               If MapUsers(OldMap).Index(LoopC) = UserIndex Then Exit For
           Next LoopC
           'Move the rest of the list backwards
           For LoopC = LoopC To MapInfo(OldMap).NumUsers
               MapUsers(OldMap).Index(LoopC) = MapUsers(OldMap).Index(LoopC + 1)
           Next LoopC
           'Resize the list
           ReDim Preserve MapUsers(OldMap).Index(1 To MapInfo(OldMap).NumUsers)
       Else
           Unload_Map OldMap
           Erase MapUsers(OldMap).Index()
       End If

       'Check if the user is on the correct server
       If CorrectServer = 0 Then

           'Disconnect the user
           UserList(UserIndex).Flags.Disconnecting = 1
       
       'User is already on the correct server
       Else
       
           'Check if it is a new map - if so, load the new map if needed
           If OldMap <> Map Then Load_Maps_Temp Map

           'Tell client to try switching maps
           ConBuf.PreAllocate 6
           ConBuf.Put_Byte DataCode.Map_LoadMap
           ConBuf.Put_Integer Map
           ConBuf.Put_Integer MapInfo(Map).MapVersion
           Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
   
           'Show Character to others
           User_MakeChar ToMap, UserIndex, UserIndex, UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y
           
           'Move the user's slaves
           For LoopC = 1 To UserList(UserIndex).NumSlaves
       
               With NPCList(UserList(UserIndex).SlaveNPCIndex(LoopC))
               
                   If MapInfo(.Pos.Map).DataLoaded Then
   
                       'Erase the NPC from the old map
                       MapInfo(.Pos.Map).Data(.Pos.X, .Pos.Y).NPCIndex = 0
   
                       'Send erase command to clients
                       ConBuf.PreAllocate 3
                       ConBuf.Put_Byte DataCode.Server_EraseChar
                       ConBuf.Put_Integer .Char.CharIndex
                       Data_Send ToMap, 0, ConBuf.Get_Buffer, .Pos.Map
                       
                   End If
                   
                   'Set the new position
                   Server_ClosestLegalPos UserList(UserIndex).Pos, .Pos
                   If Not Server_LegalPos(.Pos.Map, .Pos.X, .Pos.Y, 0) Then
                       NPC_Close UserList(UserIndex).SlaveNPCIndex(LoopC)
                   Else
                       NPC_MakeChar ToMap, UserIndex, UserList(UserIndex).SlaveNPCIndex(LoopC), .Pos.Map, .Pos.X, .Pos.Y
                   End If
                   
               End With
               
           Next LoopC
               
           'Check to update the database
           If MySQLUpdate_UserMap Then
               Log "User_WarpChar: Updating database with new map", CodeTracker '//\\LOGLINE//\\
               DB_RS.Open "SELECT * FROM users WHERE `name`='" & UserList(UserIndex).Name & "'", DB_Conn, adOpenStatic, adLockOptimistic
               DB_RS!pos_map = Map
               DB_RS.Update
               DB_RS.Close
           End If
           
       End If
           
   Else
       
       'User didn't change maps, just move their position
       Log "User_WarpChar: Moving user, map is not changing", CodeTracker '//\\LOGLINE//\\
       
       'Remove the user from the tile
       MapInfo(Map).Data(UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex = 0
       
       'Update their position
       UserList(UserIndex).Pos.X = X
       UserList(UserIndex).Pos.Y = Y
       
       'Set them on the new tile
       MapInfo(Map).Data(UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex = 0
       
       'Send the update packet to everyone on the map
       User_MakeChar ToMap, UserIndex, UserIndex, Map, X, Y
       
       'Update the user's char index
       ConBuf.PreAllocate 3
       ConBuf.Put_Byte DataCode.Server_UserCharIndex
       ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex
       Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
   
       'Move the user's slaves
       For LoopC = 1 To UserList(UserIndex).NumSlaves
       
           With NPCList(UserList(UserIndex).SlaveNPCIndex(LoopC))
           
               If MapInfo(.Pos.Map).DataLoaded Then

                   'Erase the NPC from the old map
                   MapInfo(.Pos.Map).Data(.Pos.X, .Pos.Y).NPCIndex = 0
               
                   'Send erase command to clients
                   ConBuf.PreAllocate 3
                   ConBuf.Put_Byte DataCode.Server_EraseChar
                   ConBuf.Put_Integer .Char.CharIndex
                   Data_Send ToMap, 0, ConBuf.Get_Buffer, .Pos.Map
                   
               End If
               
               'Set the new position
               Server_ClosestLegalPos UserList(UserIndex).Pos, .Pos
               If Not Server_LegalPos(.Pos.Map, .Pos.X, .Pos.Y, 0) Then
                   NPC_Close UserList(UserIndex).SlaveNPCIndex(LoopC)
               Else
                   NPC_MakeChar ToMap, UserIndex, UserList(UserIndex).SlaveNPCIndex(LoopC), .Pos.Map, .Pos.X, .Pos.Y
               End If
               
           End With
           
       Next LoopC
       
   End If

End Sub </vb>

Fix - Server_LegalPos NPCIndex crash

Open GameServer.vbp.

Find:

<vb>

           'Check if we count whether our slave NPCs count as blocked or not
           If IgnoreSlaves Then
               If NPCList(.NPCIndex).OwnerIndex = 0 Then
                   Log "Rtrn Server_LegalPos = " & Server_LegalPos, CodeTracker '//\\LOGLINE//\\
                   Exit Function
               End If
           Else
               Log "Rtrn Server_LegalPos = " & Server_LegalPos, CodeTracker '//\\LOGLINE//\\
               Exit Function
           End If

</vb>

Replace with:

<vb>

           If .NPCIndex < LastNPC Then
               'Check if we count whether our slave NPCs count as blocked or not
               If IgnoreSlaves Then
                   If NPCList(.NPCIndex).OwnerIndex = 0 Then
                       Log "Rtrn Server_LegalPos = " & Server_LegalPos, CodeTracker '//\\LOGLINE//\\
                       Exit Function
                   End If
               Else
                   Log "Rtrn Server_LegalPos = " & Server_LegalPos, CodeTracker '//\\LOGLINE//\\
                   Exit Function
               End If
           End If

</vb>

Fix - GOREsockServer

See Fix - GOREsockServer MaxConnectionsPerIP.

Fix - /who crashing

Open GameServer.vbp.

Find:

<vb>

   'Send the user names
   For i = 1 To (intNumUsers \ 10) + 1 'Replace the 10's with the number of users per line
       tStr = vbNullString             'Clear the string buffer
       For LoopC = 1 To 10
           If LoopC + ((i - 1) * 10) > intNumUsers Then Exit For
           tStr = tStr & UserNames(LoopC + ((i - 1) * 10)) & ", "
       Next LoopC
       tStr = Left$(tStr, Len(tStr) - 2)   'Crop off the last comma
       ConBuf.Allocate 3 + Len(tStr)
       ConBuf.Put_Byte DataCode.Comm_Talk
       ConBuf.Put_String tStr
       ConBuf.Put_Byte DataCode.Comm_FontType_Info
   Next i

   'Send all the lines as a whole
   Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer

</vb>

Replace with:

<vb>

   'Send the user names
   For i = 1 To (intNumUsers \ 10) + 1 'Replace the 10's with the number of users per line
       tStr = vbNullString             'Clear the string buffer
       For LoopC = 1 To 10
           If LoopC + ((i - 1) * 10) > intNumUsers Then Exit For
           tStr = tStr & UserNames(LoopC + ((i - 1) * 10)) & ", "
       Next LoopC
       If Len(tStr) > 2 Then
           tStr = Left$(tStr, Len(tStr) - 2)   'Crop off the last comma
           ConBuf.Allocate 3 + Len(tStr)
           ConBuf.Put_Byte DataCode.Comm_Talk
           ConBuf.Put_String tStr
           ConBuf.Put_Byte DataCode.Comm_FontType_Info
       End If
   Next i

   'Send all the lines as a whole
   If ConBuf.HasBuffer Then Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer

</vb>

Fix - Connect screen CPU usage

Open GameClient.vbp.

Find:

<vb>

       If FPSCap > 0 Then
           If (timeGetTime - StartTime) < FPSCap Then  'If Elapsed Time < Time required for requested highest fps
               Sleep FPSCap - (timeGetTime - StartTime)
           End If
       End If

</vb>

Replace with:

<vb>

       If Not frmMain.Visible Then
           Sleep 100   'Don't hog resources at connect screen
       Else
           If FPSCap > 0 Then
               If (timeGetTime - StartTime) < FPSCap Then  'If Elapsed Time < Time required for requested highest fps
                   Sleep FPSCap - (timeGetTime - StartTime)
               End If
           End If
       End If

</vb>

Fix - Object only quests message

Open GameServer.vbp.

Find:

<vb>

           'No object or NPC requirement found! Stupid quests don't deserve to be talked about

</vb>

Two lines above, find (only edit this one, not the one 8 lines above):

<vb>

           MessageID = 11                      'Needs object

</vb>

Replace with:

<vb>

           MessageID = 10                      'Needs object only

</vb>