Upgrade 1.0.4 to 1.0.5
From VbGORE Visual Basic Online RPG Engine
This guide will lead you through how to upgrade Version 1.0.4 to Version 1.0.5. For help, please refer to the How to upgrade article. It is highly recommended you read it before ever upgrading.
Add - Texture compression and reverse sound options
Open \Data\Game.ini.
Anywhere in the [INIT] section, add:
<ini> //Uses slightly more CPU usage on texture loading, but significantly less RAM TextureCompression=1
//Swap the left and right speakers, reversing the sound ReverseSound=0 </ini>
Open GameClient.vbp.
Find:
<vb> Public DisableChatBubbles As Byte 'If chat bubbles are drawn or not - chat bubbles can be a huge FPS drainer </vb>
Before, add:
<vb> Public ReverseSound As Integer 'Reverse the left and right speakers Public TextureCompress As Long 'Compress textures, saving lots of RAM at an insignifcant CPU usage cost (may reduce graphic quality!) </vb>
Find:
<vb> Bit32 = Val(Var_Get(DataPath & "Game.ini", "INIT", "32bit")) </vb>
Before, add:
<vb>
ReverseSound = Val(Var_Get(DataPath & "Game.ini", "INIT", "ReverseSound")) If ReverseSound <> 0 Then ReverseSound = -1 Else ReverseSound = 1 'Force to -1 or 1 TextureCompress = Val(Var_Get(DataPath & "Game.ini", "INIT", "TextureCompression")) If TextureCompress <> 0 Then TextureCompress = D3DFMT_DXT5 'Force to 0 or D3DFMT_DXT5
</vb>
Find:
<vb>
Set SurfaceDB(TextureNum) = D3DX.CreateTextureFromFileEx(D3DDevice, FilePath, D3DX_DEFAULT, D3DX_DEFAULT, 0, 0, D3DFMT_DXT5, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_NONE, &HFF000000, TexInfo, ByVal 0)
</vb>
Replace with:
<vb>
Set SurfaceDB(TextureNum) = D3DX.CreateTextureFromFileEx(D3DDevice, FilePath, D3DX_DEFAULT, D3DX_DEFAULT, 0, 0, TextureCompress, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_NONE, &HFF000000, TexInfo, ByVal 0)
</vb>
Find:
<vb>
Set SurfaceDB(TextureNum) = D3DX.CreateTextureFromFileEx(D3DDevice, FilePath, SurfaceSize(TextureNum).X, SurfaceSize(TextureNum).Y, 0, 0, D3DFMT_DXT5, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_NONE, &HFF000000, ByVal 0, ByVal 0)
</vb>
Replace with:
<vb>
Set SurfaceDB(TextureNum) = D3DX.CreateTextureFromFileEx(D3DDevice, FilePath, SurfaceSize(TextureNum).X, SurfaceSize(TextureNum).Y, 0, 0, TextureCompress, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_NONE, &HFF000000, ByVal 0, ByVal 0)
</vb>
Find:
<vb>
Sound_CalcPan = (x1 - x2) * 75
</vb>
Replace with:
<vb>
Sound_CalcPan = (x1 - x2) * 75 * ReverseSound
</vb>
Change - Better GameConfig
Replace your GameConfig code with the code found in v1.0.5.
Fix - Game_ClosestTargetNPC fixes
Open GameClient.vbp.
Find:
<vb> Function Game_ClosestTargetNPC() As Integer </vb>
After, add:
<vb> Dim CharValue() As Long </vb>
Find:
<vb>
If LastChar = 1 Then Exit Function 'If theres only one character, its probably the user
</vb>
Replace with:
<vb>
If LastChar <= 1 Then Exit Function 'If theres only one character, its probably the user
</vb>
In that routine, find:
<vb>
If j <> TargetCharIndex Then
</vb>
After, add:
<vb>
If CharList(j).CharType = ClientCharType_NPC Then
</vb>
Go to the bottom of the function and add an End If to end the condition.
Add - Map editor crash check
There is currently no guide for this feature. It is recommended you just copy over the whole map editor since it is unlikely you have changed it.
Fix - Grouping char types (part 3)
Open GameServer.vbp.
Find:
<vb>
'Tell the group members the user joined and change the char type ConBuf.PreAllocate 7 + Len(UserList(UserIndex).Name) ConBuf.Put_Byte DataCode.Server_Message ConBuf.Put_Byte 108 ConBuf.Put_String UserList(UserIndex).Name ConBuf.Put_Byte DataCode.Server_ChangeCharType ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex ConBuf.Put_Byte ClientCharType_Grouped Data_Send ToGroupButIndex, UserIndex, ConBuf.Get_Buffer
</vb>
Replace with:
<vb>
'Tell the group members the user joined and change the char type ConBuf.PreAllocate 7 + Len(UserList(UserIndex).Name) ConBuf.Put_Byte DataCode.Server_Message ConBuf.Put_Byte 108 ConBuf.Put_String UserList(UserIndex).Name ConBuf.Put_Byte DataCode.Server_ChangeCharType ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex ConBuf.Put_Byte ClientCharType_Grouped Data_Send ToGroup, UserIndex, ConBuf.Get_Buffer
</vb>
Find:
<vb>
'Tell everyone else they have left
ConBuf.PreAllocate 3 + Len(UserList(UserIndex).Name)
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 110
ConBuf.Put_String UserList(UserIndex).Name
Data_Send ToGroupButIndex, UserIndex, ConBuf.Get_Buffer
</vb>
Replace with:
<vb>
'Tell everyone else they have left
ConBuf.PreAllocate 7 + Len(UserList(UserIndex).Name)
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 110
ConBuf.Put_String UserList(UserIndex).Name
ConBuf.Put_Byte DataCode.Server_ChangeCharType
ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex
ConBuf.Put_Byte ClientCharType_PC
Data_Send ToGroup, UserIndex, ConBuf.Get_Buffer
</vb>
Find and delete:
<vb>
'Update everyone in the map that is part of the group that the user has changed out of the group ConBuf.PreAllocate 4 ConBuf.Put_Byte DataCode.Server_ChangeCharType ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex ConBuf.Put_Byte ClientCharType_PC Data_Send ToMapGroupButIndex, UserIndex, ConBuf.Get_Buffer
</vb>
Fix - Attack client crash
Open GameClient.vbp.
Find:
<vb>
If Input_Keys_IsPressed(KeyDefinitions.Attack, KeyCode) Then
</vb>
After, add:
<vb>
If UserCharIndex > 0 Then
</vb>
Add an End If at the end of the nest to close it off.
<vb>
Else
sndBuf.Allocate 2
sndBuf.Put_Byte DataCode.User_Attack
sndBuf.Put_Byte CharList(UserCharIndex).Heading
End If
End If
End If
End If
</vb>
Change - MySQL connect messages
Open GameServer.vbp.
Find:
<vb> Public Sub MySQL_Init() </vb>
Replace whole sub with:
<vb> Public Sub MySQL_Init() Dim ErrorString As String Dim i As Long
On Error GoTo ErrOut
'Create the database connection object
Set DB_Conn = New ADODB.Connection
Set DB_RS = New ADODB.Recordset
'Get the variables
DB_User = Trim$(Var_Get(ServerDataPath & "Server.ini", "MYSQL", "User"))
DB_Pass = Trim$(Var_Get(ServerDataPath & "Server.ini", "MYSQL", "Password"))
DB_Name = Trim$(Var_Get(ServerDataPath & "Server.ini", "MYSQL", "Database"))
DB_Host = Trim$(Var_Get(ServerDataPath & "Server.ini", "MYSQL", "Host"))
DB_Port = Val(Var_Get(ServerDataPath & "Server.ini", "MYSQL", "Port"))
'Create the connection
DB_Conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & DB_Host & _
";DATABASE=" & DB_Name & ";PORT=" & DB_Port & ";UID=" & DB_User & ";PWD=" & DB_Pass & ";OPTION=3"
DB_Conn.CursorLocation = adUseClient
DB_Conn.Open
'Run test queries to make sure the tables are there
DB_RS.Open "SELECT * FROM banned_ips WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
DB_RS.Close
DB_RS.Open "SELECT * FROM mail WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
DB_RS.Close
DB_RS.Open "SELECT * FROM mail_lastid WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
DB_RS.Close
DB_RS.Open "SELECT * FROM npcs WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
DB_RS.Close
DB_RS.Open "SELECT * FROM objects WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
DB_RS.Close
DB_RS.Open "SELECT * FROM quests WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
DB_RS.Close
DB_RS.Open "SELECT * FROM users WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
DB_RS.Close
On Error GoTo 0 Exit Sub
ErrOut:
'Refresh the errors
DB_Conn.Errors.Refresh
'Get the error string if there is one
If DB_Conn.Errors.Count > 0 Then ErrorString = DB_Conn.Errors.Item(0).Description
Debug.Print ErrorString
'Check for known errors
If InStr(1, ErrorString, "Access denied for user ") Then
'Invalid username or password
ShellExecute frmMain.hwnd, vbNullString, "http://www.vbgore.com/MySQL_Setup#Access_denied", vbNullString, "c:\", 10
MsgBox "Error connecting to the MySQL database!" & vbNewLine & _
"An incorrect username and/or password was entered into the configuration file." & vbNewLine & _
"This information can be changed in the \ServerData\Server.ini file on the 'User=' and 'Password=' lines." & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
"Username: " & DB_User & " Password: " & DB_Pass & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & vbNewLine & _
"MySQL returned the following error message: " & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
ErrorString & vbNewLine & _
"---------------------------------------------------------------------------------------------------"
ElseIf InStr(1, ErrorString, "Can't connect to MySQL server on ") Then
'Unable to connect to MySQL
ShellExecute frmMain.hwnd, vbNullString, "http://www.vbgore.com/MySQL_Setup#Can.27t_connect_to_MySQL_server", vbNullString, "c:\", 10
MsgBox "Error connecting to the MySQL database!" & vbNewLine & _
"Either an invalid MySQL server IP and/or port was entered, or the server isn't running!" & vbNewLine & _
"Please confirm you installed MySQL 5.0 and ran the Instance Configuration." & vbNewLine & _
"To manually start the instance, do the following:" & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
"Right-click 'My Computer' -> 'Manage' -> 'Services and Applications' -> 'Services'" & vbNewLine & _
"Find your MySQL service in this list (name usually starts with 'MySQL'), right-click it and click 'Start'" & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & vbNewLine & _
"MySQL returned the following error message: " & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
ErrorString & vbNewLine & _
"---------------------------------------------------------------------------------------------------"
ElseIf InStr(1, ErrorString, "Unknown database ") Then
'Invalid database name / database does not exist
ShellExecute frmMain.hwnd, vbNullString, "http://www.vbgore.com/MySQL_Setup#Unknown_database", vbNullString, "c:\", 10
MsgBox "Error connecting to the MySQL database!" & vbNewLine & _
"An invalid or unknown database name, '" & DB_Name & "', was entered." & vbNewLine & _
"This information can be changed in the \ServerData\Server.ini file on the 'Database=' line." & vbNewLine & vbNewLine & _
"MySQL returned the following error message: " & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
ErrorString & vbNewLine & _
"---------------------------------------------------------------------------------------------------"
ElseIf InStr(1, ErrorString, "Data source name not found and no default driver specified") Then
'Invalid database name / database does not exist
ShellExecute frmMain.hwnd, vbNullString, "http://www.vbgore.com/MySQL_Setup#Driver_not_found", vbNullString, "c:\", 10
MsgBox "Error connecting to the MySQL database!" & vbNewLine & _
"No valid driver could be found on this computer to connect to MySQL." & vbNewLine & _
"Please make sure you install ODBC v3.51 (must be v3.51) on this computer!" & vbNewLine & _
"ODBC can be downloaded from:" & vbNewLine & _
"http://dev.mysql.com/downloads/connector/odbc/3.51.html" & vbNewLine & vbNewLine & _
"MySQL returned the following error message: " & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
ErrorString & vbNewLine & _
"---------------------------------------------------------------------------------------------------"
ElseIf InStr(1, ErrorString, "Table '") & InStr(1, ErrorString, "' doesn't exist") Then
'At least one of the tables are missing
ShellExecute frmMain.hwnd, vbNullString, "http://www.vbgore.com/MySQL_Setup#Table_doesn.27t_exist", vbNullString, "c:\", 10
MsgBox "Error connecting to the MySQL database!" & vbNewLine & _
"One or more of the tables required were not found." & vbNewLine & _
"Please make sure you import the 'vbgore.sql' file found in the folder '/_Database Dump/' into the database." & vbNewLine & vbNewLine & _
"MySQL returned the following error message: " & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
ErrorString & vbNewLine & _
"---------------------------------------------------------------------------------------------------"
Else
'Unknown error
MsgBox "Unknown error connecting to the MySQL database!" & vbNewLine & _
"Please confirm that you have completed the following tasks:" & vbNewLine & vbNewLine & _
" - You have followed ALL of the steps on the MySQL Setup page on the vbGORE site" & vbNewLine & _
" - MySQL is running and you can connect to it through a GUI such as SQLyog" & vbNewLine & _
" - You have imported the vbgore.sql file into the database and can see the information through the MySQL GUI" & vbNewLine & _
" - You have version 5.0 of MySQL and 3.51 of ODBC being used" & vbNewLine & _
" - You changed the \ServerData\Server.ini file to use your MySQL information" & vbNewLine & vbNewLine & _
"If you are positive you have done all of the above, ask for help on the vbGORE forums." & vbNewLine & vbNewLine & _
"MySQL returned the following error message: " & vbNewLine & _
"---------------------------------------------------------------------------------------------------" & vbNewLine & _
ErrorString & vbNewLine & _
"---------------------------------------------------------------------------------------------------", vbOKOnly
End If
Server_Unload
End Sub </vb>
Find:
<vb> Public DB_RS As ADODB.Recordset </vb>
After, add:
<vb> 'API to open the browser (used for MySQL connection errors) Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long </vb>
Fix - /groupinfo
Open GameServer.vbp.
Find:
<vb> Sub Data_User_Group_Info(ByVal UserIndex As Integer) </vb>
Replace whole sub with:
<vb> Sub Data_User_Group_Info(ByVal UserIndex As Integer)
'***************************************************************** 'User requests the information of their group '<> '***************************************************************** Dim i As Byte
'Check if the user is in a group
If UserList(UserIndex).GroupIndex = 0 Then
Data_Send ToIndex, UserIndex, cMessage(123).Data()
Exit Sub
End If
'Create the list to send to the user
ConBuf.Clear
For i = 1 To GroupData(UserList(UserIndex).GroupIndex).NumUsers
ConBuf.Allocate 9
ConBuf.Put_Byte DataCode.Comm_Talk
ConBuf.Put_String "* " & UserList(GroupData(UserList(UserIndex).GroupIndex).Users(i)).Name & "(" & UserList(GroupData(UserList(UserIndex).GroupIndex).Users(i)).Stats.BaseStat(SID.ELV) & ")"
ConBuf.Put_Byte DataCode.Comm_FontType_Group
Next i
'Create the group text packet
If ConBuf.HasBuffer Then Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End Sub </vb>
Add - Map editor hotkeys
There is currently no guide for this feature. It is recommended you just copy over the whole map editor since it is unlikely you have changed it.
Add - Map editor auto-save
There is currently no guide for this feature. It is recommended you just copy over the whole map editor since it is unlikely you have changed it.
Fix - Mini-map char display
Open GameClient.vbp.
Find:
<vb>
'************** Mini-map **************
</vb>
Replace from that line to the end of the sub with:
<vb>
'************** Mini-map **************
Const tS As Single = 3 'Size of the mini-map dots
'Check if the mini-map is being shownquit
If ShowMiniMap Then
'Make sure the mini-map vertex buffer is valid
If MiniMapVBSize > 0 Then
'Clear the texture
LastTexture = 0
D3DDevice.SetTexture 0, Nothing
'Draw the map outline
D3DDevice.SetStreamSource 0, MiniMapVB, FVF_Size
D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, MiniMapVBSize \ 3
'Draw the characters
For X = 1 To LastChar
If CharList(X).Active Then
'The user's character
If X = UserCharIndex Then
j = D3DColorARGB(200, 0, 255, 0) 'User's character
Engine_Render_Rectangle CharList(X).Pos.X * tS, CharList(X).Pos.Y * tS, tS, tS, 1, 1, 1, 1, 1, 1, 0, 0, j, j, j, j, , False
GoTo NextChar
End If
'Part of the user's group or one of the user's slaves
If CharList(X).CharType = ClientCharType_Grouped Or (CharList(X).CharType = ClientCharType_Slave And UserCharIndex = CharList(X).OwnerChar) Then
If X <> UserCharIndex Then
j = D3DColorARGB(200, 100, 220, 100) 'PC (grouped) or the user's slave
Engine_Render_Rectangle CharList(X).Pos.X * tS, CharList(X).Pos.Y * tS, tS, tS, 1, 1, 1, 1, 1, 1, 0, 0, j, j, j, j, , False
GoTo NextChar
End If
End If
'Check if the character is in screen, since the only characters drawn outside of the screen are grouped characters
If CharList(X).Pos.X > ScreenMinX Then
If CharList(X).Pos.X < ScreenMaxX Then
If CharList(X).Pos.Y > ScreenMinY Then
If CharList(X).Pos.Y < ScreenMaxY Then
'Character is a PC
If CharList(X).CharType = ClientCharType_PC Then
j = D3DColorARGB(200, 0, 255, 255) 'PC (not grouped)
'Character is a NPC
Else
j = D3DColorARGB(200, 0, 150, 150) 'NPC
End If
'Any character but one part of the user's group
Engine_Render_Rectangle CharList(X).Pos.X * tS, CharList(X).Pos.Y * tS, tS, tS, 1, 1, 1, 1, 1, 1, 0, 0, j, j, j, j, , False
End If
End If
End If
End If
End If
NextChar:
Next X
End If
End If
'Show FPS Engine_Render_Text "FPS: " & FPS, ScreenWidth - 80, 2, -1
End Sub </vb>
Fix - Random map editor bugs
Open EditorMap.vbp.
Find:
<vb>
LastOffsetY = 0
</vb>
After, add:
<vb>
'Clear the weather MapInfo.Weather = 0 WeatherEffectIndex = 0
</vb>
Find:
<vb>
If Val(GrhTxt.Text) > UBound(GrhData) Then Exit Sub
</vb>
Replace with:
<vb>
If Val(GrhTxt.Text) > UBound(GrhData) Then GrhTxt.Text = UBound(GrhData)
</vb>
Go to form frmSetTile.
Add:
<vb> Private Sub LightTxt_Change(Index As Integer) Dim i As Long Dim b As Long
On Error GoTo ErrOut i = Val(LightTxt(Index).Text) Exit Sub
ErrOut:
'Set b as 1 by default (light value is positive)
b = 1
'If the light value is negative, set b to -1
If Len(LightTxt(Index).Text) > 1 Then
If Left$(LightTxt(Index).Text, 1) = "-" Then
b = -1
End If
End If
'Set the value to negative or positive accordingly, then move 1 value
' closer to 0 (for negative, add, for positive, subtract) to keep in range
LightTxt(Index).Text = b * (2 ^ 31) - b
End Sub </vb>
Find:
<vb> Private Sub IndexTxt_Change() </vb>
Replace whole sub with:
<vb> Private Sub IndexTxt_Change() Dim i As Byte
If EditChk.Value = 0 Then Exit Sub On Error GoTo ErrOut i = Val(IndexTxt.Text) If i < 1 Then GoTo ErrOut If Effect(ParticlesList.ListIndex + 1).Used Then Effect(ParticlesList.ListIndex + 1).EffectNum = i
ErrOut:
End Sub </vb>
Find:
<vb> Private Sub IndexTxt_KeyPress(KeyAscii As Integer) </vb>
After, add:
<vb>
If ParticlesList.ListIndex + 1 = WeatherEffectIndex Then
KeyAscii = 0
Exit Sub
End If
</vb>
After each of the following:
<vb> Private Sub ParticlesTxt_KeyPress(KeyAscii As Integer) </vb>
<vb> Private Sub XTxt_KeyPress(KeyAscii As Integer) </vb>
<vb> Private Sub YTxt_KeyPress(KeyAscii As Integer) </vb>
<vb> Private Sub DirTxt_KeyPress(KeyAscii As Integer) </vb>
<vb> Private Sub GfxTxt_KeyPress(KeyAscii As Integer) </vb>
Add:
<vb>
If ParticlesList.ListIndex + 1 = WeatherEffectIndex Or EditChk.Value = False Then
KeyAscii = 0
Exit Sub
End If
</vb>
Find:
<vb>
frmParticles.ParticlesList.AddItem "ID: " & Effect(i).EffectNum & " X: " & Effect(i).X + ParticleOffsetX & " Y: " & Effect(i).Y + ParticleOffsetY & " P: " & Effect(i).ParticleCount
</vb>
Replace with:
<vb>
frmParticles.ParticlesList.AddItem "ID: " & Effect(i).EffectNum & " X: " & Effect(i).X + ParticleOffsetX - 288 & " Y: " & Effect(i).Y + ParticleOffsetY - 288 & " P: " & Effect(i).ParticleCount
</vb>
Find:
<vb>
XTxt.Text = .X + ParticleOffsetX
YTxt.Text = .Y + ParticleOffsetY
</vb>
Replace with:
<vb>
XTxt.Text = .X + ParticleOffsetX - 288
YTxt.Text = .Y + ParticleOffsetY - 288
</vb>
Find:
<vb>
If Effect(ParticlesList.ListIndex + 1).Used Then Effect(ParticlesList.ListIndex + 1).Y = Y
</vb>
Replace with:
<vb>
If Effect(ParticlesList.ListIndex + 1).Used Then Effect(ParticlesList.ListIndex + 1).Y = Y + 288
</vb>
Find:
<vb>
If Effect(ParticlesList.ListIndex + 1).Used Then Effect(ParticlesList.ListIndex + 1).X = X
</vb>
Replace with:
<vb>
If Effect(ParticlesList.ListIndex + 1).Used Then Effect(ParticlesList.ListIndex + 1).X = X + 288
</vb>
Fix - Grouping char types (part 2)
Open GameServer.vbp.
Find:
<vb>
'Join group message ConBuf.PreAllocate 3 + Len(UserList(GroupData(GroupIndex).Users(1)).Name) ConBuf.Put_Byte DataCode.Server_Message ConBuf.Put_Byte 107 ConBuf.Put_String UserList(GroupData(GroupIndex).Users(1)).Name Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
</vb>
Replace with:
<vb>
'Join group message and tell the user that just joined who else is in the group
ConBuf.PreAllocate 3 + Len(UserList(GroupData(GroupIndex).Users(1)).Name) + ((GroupData(GroupIndex).NumUsers - 1) * 4)
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 107
ConBuf.Put_String UserList(GroupData(GroupIndex).Users(1)).Name
If GroupData(GroupIndex).NumUsers > 1 Then
For i = 1 To GroupData(GroupIndex).NumUsers - 1
ConBuf.Put_Byte DataCode.Server_ChangeCharType
ConBuf.Put_Integer UserList(GroupData(GroupIndex).Users(i)).Char.CharIndex
ConBuf.Put_Byte ClientCharType_Grouped
Next i
End If
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
</vb>
At the top of the same sub, add:
<vb> Dim i As Byte </vb>
Find:
<vb>
'Tell the user they have left the group Data_Send ToIndex, UserIndex, cMessage(109).Data()
</vb>
Replace with:
<vb>
'Tell the user they have left the group and change all current group members to not group members for the UserIndex
ConBuf.PreAllocate (4 * GroupData(GroupIndex).NumUsers) + 2
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 109
For i = 1 To GroupData(GroupIndex).NumUsers
ConBuf.Put_Byte DataCode.Server_ChangeCharType
ConBuf.Put_Integer UserList(GroupData(GroupIndex).Users(i)).Char.CharIndex
ConBuf.Put_Byte ClientCharType_PC
Next i
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
</vb>
Find and delete:
<vb>
'Set the character as no longer part of the group ConBuf.PreAllocate 4 ConBuf.Put_Byte DataCode.Server_ChangeCharType ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex ConBuf.Put_Byte ClientCharType_PC Data_Send ToGroup, UserIndex, ConBuf.Get_Buffer()
</vb>
Fix - Particle texture recycle bug
Open GameClient.vbp.
Find:
<vb>
'Set the texture D3DDevice.SetTexture 0, ParticleTexture(Effect(EffectIndex).Gfx)
</vb>
Before, add:
<vb>
'Set the last texture to a random number to force the engine to reload the texture LastTexture = -65489
</vb>
Fix - Valid map check on char creation
Open GameServer.vbp.
Find both instance of:
<vb>
'Place character on map
</vb>
Before both, add:
<vb>
'Check for a valid send index
If sndRoute = ToIndex Then
If UserList(sndIndex).Pos.Map <> Map Then Exit Sub
End If
</vb>
Fix - Group char types
Open GameServer.vbp.
Find:
<vb>
'Tell the group members the user joined ConBuf.PreAllocate 3 + Len(UserList(UserIndex).Name) ConBuf.Put_Byte DataCode.Server_Message ConBuf.Put_Byte 108 ConBuf.Put_String UserList(UserIndex).Name Data_Send ToGroupButIndex, UserIndex, ConBuf.Get_Buffer
</vb>
Replace with:
<vb>
'Tell the group members the user joined and change the char type ConBuf.PreAllocate 7 + Len(UserList(UserIndex).Name) ConBuf.Put_Byte DataCode.Server_Message ConBuf.Put_Byte 108 ConBuf.Put_String UserList(UserIndex).Name ConBuf.Put_Byte DataCode.Server_ChangeCharType ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex ConBuf.Put_Byte ClientCharType_Grouped Data_Send ToGroupButIndex, UserIndex, ConBuf.Get_Buffer
</vb>
Find:
<vb>
Data_Send ToIndex, UserIndex, cMessage(109).Data()
</vb>
After, add:
<vb>
'Set the character as no longer part of the group ConBuf.PreAllocate 4 ConBuf.Put_Byte DataCode.Server_ChangeCharType ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex ConBuf.Put_Byte ClientCharType_PC Data_Send ToGroup, UserIndex, ConBuf.Get_Buffer()
</vb>
Fix - Delete shadow flag when deleting tile
Open EditorMap.vbp.
Find:
<vb>
.Graphic(i).GrhIndex = 0
</vb>
After, add:
<vb>
.Shadow(i) = 0
</vb>
Find:
<vb>
.Graphic(DrawLayer).GrhIndex = 0
</vb>
After, add:
<vb>
.Shadow(DrawLayer) = 0
</vb>
Fix - Map editor particles form
Open EditorMap.vbp.
Find and delete:
<vb>
If X < 1 Then GoTo ErrOut
</vb>
<vb>
If Y < 1 Then GoTo ErrOut
</vb>
Change - Faster rectangle collision detection
Open GameClient.vbp.
Find and delete:
<vb> Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long </vb>
Find:
<vb> Function Engine_Collision_Rect(ByVal x1 As Integer, ByVal Y1 As Integer, ByVal Width1 As Integer, ByVal Height1 As Integer, ByVal x2 As Integer, ByVal Y2 As Integer, ByVal Width2 As Integer, ByVal Height2 As Integer) As Boolean </vb>
Replace with:
<vb> Function Engine_Collision_Rect(ByVal x1 As Integer, ByVal Y1 As Integer, ByVal Width1 As Integer, ByVal Height1 As Integer, ByVal x2 As Integer, ByVal Y2 As Integer, ByVal Width2 As Integer, ByVal Height2 As Integer) As Boolean
'***************************************************************** 'Check for collision between two rectangles '*****************************************************************
If x1 + Width1 >= x2 Then
If x1 <= x2 + Width2 Then
If Y1 + Height1 >= Y2 Then
If Y1 <= Y2 + Height2 Then
Engine_Collision_Rect = True
End If
End If
End If
End If
End Function </vb>
Fix - Better map object deletion
Open GameServer.vbp.
Find:
<vb>
ConBuf.PreAllocate 3
ConBuf.Put_Byte DataCode.Server_EraseObject
ConBuf.Put_Byte CByte(X)
ConBuf.Put_Byte CByte(Y)
Data_Send ToMap, 0, ConBuf.Get_Buffer, Map, PP_GroundObjects
</vb>
Replace with:
<vb>
ConBuf.PreAllocate 7
ConBuf.Put_Byte DataCode.Server_EraseObject
ConBuf.Put_Byte CByte(X)
ConBuf.Put_Byte CByte(Y)
ConBuf.Put_Long ObjData.GrhIndex(MapInfo(Map).ObjTile(X, Y).ObjInfo(ObjSlot).ObjIndex)
Data_Send ToMap, 0, ConBuf.Get_Buffer, Map, PP_GroundObjects
</vb>
Open GameClient.vbp.
Find:
<vb> Sub Data_Server_EraseObject(ByRef rBuf As DataBuffer) </vb>
Replace sub with:
<vb> Sub Data_Server_EraseObject(ByRef rBuf As DataBuffer)
'********************************************* 'Erase an object on the object layer '<X(B)><Y(B)><Grh(L)> '********************************************* Dim j As Integer Dim X As Byte Dim Y As Byte Dim Grh As Long
X = rBuf.Get_Byte Y = rBuf.Get_Byte Grh = rBuf.Get_Long
'Loop through until we find the object on (X,Y) then kill it
For j = 1 To LastObj
If OBJList(j).Pos.X = X Then
If OBJList(j).Pos.Y = Y Then
If OBJList(j).Grh.GrhIndex = Grh Then
Engine_OBJ_Erase j
Exit Sub
End If
End If
End If
Next j
End Sub </vb>
Fix - Sound volume setting
Open GameClient.vbp.
Find:
<vb>
If Value < -9000 Then Exit Sub 'Too quiet to care about
</vb>
Replace with:
<vb>
If Value < -10000 Then Value = -10000
</vb>
Add - GM GiveSkill command
Open GameServer.vbp.
Find:
<vb>
GM_SQL As Byte
</vb>
After, add:
<vb>
GM_GiveSkill As Byte
</vb>
Find:
<vb>
.GM_SQL = 112
</vb>
After, add:
<vb>
.GM_GiveSkill = 113
</vb>
Find:
<vb>
Case .GM_FindItem: Data_GM_FindItem rBuf, Index
</vb>
After, add:
<vb>
Case .GM_GiveSkill: Data_GM_GiveSkill rBuf, Index
</vb>
In sub TCP, add:
<vb> Sub Data_GM_GiveSkill(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)
'***************************************************************** 'Teaches the user a skill as long as it is a valid skill for their class '<Target(S)><SkillID(B)> '***************************************************************** Dim TargetIndex As Integer Dim Target As String Dim SkillID As Byte
Log "Call Data_GM_FindItem([" & ByteArrayToStr(rBuf.Get_Buffer) & "]," & UserIndex & ")", CodeTracker '//\\LOGLINE//\\
'Get the values string
Target = rBuf.Get_String
SkillID = rBuf.Get_Byte
'Check for invalid values
If UserList(UserIndex).Flags.GMLevel = 0 Then Exit Sub
'Find the user's index
TargetIndex = User_NameToIndex(Target)
'See if user online
If TargetIndex <= 0 Then
Data_Send ToIndex, UserIndex, cMessage(51).Data, , PP_GMMessages
Exit Sub
End If
'Give the user the skill
User_GiveSkill TargetIndex, SkillID
End Sub </vb>
Open GameClient.vbp.
Find:
<vb>
ElseIf Input_GetCommand("/SQL") Then
</vb>
Before, add:
<vb>
ElseIf Input_GetCommand("/GIVESK") Or Input_GetCommand("/GIVESP") Then
s = Input_GetBufferArgs
If s = vbNullString Then GoTo CleanUp
TempS = Split(s, " ")
If UBound(TempS) <> 1 Then GoTo CleanUp
If Val(TempS(1)) <= 0 Or Val(TempS(1)) > 255 Then Exit Sub
sndBuf.Put_Byte DataCode.GM_GiveSkill
sndBuf.Put_String TempS(0)
sndBuf.Put_Long Val(TempS(1))
</vb>
Add - GM SQL query command
Open GameServer.vbp.
Find:
<vb>
GM_FindItem As Byte
</vb>
After, add:
<vb>
GM_SQL As Byte
</vb>
Find:
<vb>
.GM_FindItem = 111
</vb>
After, add:
<vb>
.GM_SQL = 112
</vb>
Find:
<vb>
Case .GM_Summon: Data_GM_Summon rBuf, Index
</vb>
After, add:
<vb>
Case .GM_SQL: Data_GM_SQL rBuf, Index
</vb>
In sub TCP, add:
<vb> Sub Data_GM_SQL(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)
'***************************************************************** 'Runs a SQL query '<Query(S)> '***************************************************************** Dim Query As String Dim i As Long Dim s As String
On Error GoTo ExitSub
Log "Call Data_GM_SQL([" & ByteArrayToStr(rBuf.Get_Buffer) & "]," & UserIndex & ")", CodeTracker '//\\LOGLINE//\\
'Get the query
Query = rBuf.Get_String
'Check for invalid values
If UserList(UserIndex).Flags.GMLevel = 0 Then Exit Sub
'Check for combined queries using ;
If InStr(1, Query, ";") Then GoTo InvalidSQL
'Check for a valid query
If UCase$(Left$(Query, 6)) = "SELECT" Or UCase$(Left$(Query, 4)) = "SHOW" Or UCase$(Left$(Query, 8)) = "DESCRIBE" Or _
UCase$(Left$(Query, 8)) = "OPTIMIZE" Or UCase$(Left$(Query, 6)) = "REPAIR" Or UCase$(Left$(Query, 7)) = "ANALYZE" Or _
UCase$(Left$(Query, 6)) = "BACKUP" Or UCase$(Left$(Query, 5)) = "FLUSH" Then
'Run the query
DB_RS.Open Query, DB_Conn, adOpenStatic, adLockOptimistic
'Return the results
ConBuf.Clear
ConBuf.Put_Byte DataCode.Comm_Talk
ConBuf.Put_String "Results for query: |" & Query & "|"
ConBuf.Put_Byte DataCode.Comm_FontType_Info
Do While Not DB_RS.EOF
s = vbNullString
For i = 0 To DB_RS.Fields.Count - 1
If LenB(s) > 0 Then
s = s & "," & DB_RS.Fields(i)
Else
s = DB_RS.Fields(i)
End If
Next i
ConBuf.Put_Byte DataCode.Comm_Talk
ConBuf.Put_String s
ConBuf.Put_Byte DataCode.Comm_FontType_Info
DB_RS.MoveNext
Loop
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer()
'Close the record set
DB_RS.Close
Else
'Invalid query
GoTo InvalidSQL
End If
On Error GoTo 0
Exit Sub
'Invaild query return InvalidSQL:
'Return an invalid SQL message ConBuf.PreAllocate 9 ConBuf.Put_Byte DataCode.Comm_Talk ConBuf.Put_String "Invalid SQL query: " & Query ConBuf.Put_Byte DataCode.Comm_FontType_Info ConBuf.Put_Byte DataCode.Comm_Talk ConBuf.Put_String "You may only use the following commands: SELECT, SHOW, DESCRIBE, OPTIMIZE, REPAIR, ANALYZE, BACKUP, FLUSH" ConBuf.Put_Byte DataCode.Comm_FontType_Info ConBuf.Put_Byte DataCode.Comm_Talk ConBuf.Put_String "You may not use the ; character!" ConBuf.Put_Byte DataCode.Comm_FontType_Info
ExitSub:
On Error Resume Next If DB_RS.State > 0 Then DB_RS.Close On Error GoTo 0
End Sub </vb>
Open GameClient.vbp.
Find:
<vb>
ElseIf Input_GetCommand("/RAISE") Then
</vb>
Before, add:
<vb>
ElseIf Input_GetCommand("/SQL") Then
s = Input_GetBufferArgs
If s = vbNullString Then GoTo CleanUp
sndBuf.Put_Byte DataCode.GM_SQL
sndBuf.Put_String s
</vb>
Add - GM item searching
Open GameServer.vbp.
Find:
<vb>
GM_Warp As Byte
</vb>
After, add:
<vb>
GM_FindItem As Byte
</vb>
Find:
<vb>
.Server_MakeCharCached = 110
</vb>
After, add:
<vb>
.GM_FindItem = 111
</vb>
Find:
<vb>
Case .GM_DeThrall: Data_GM_DeThrall rBuf, Index
</vb>
After, add:
<vb>
Case .GM_FindItem: Data_GM_FindItem rBuf, Index
</vb>
In sub TCP, add:
<vb> Sub Data_GM_FindItem(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)
'***************************************************************** 'Searches for an item '<SearchStr(S)> '***************************************************************** Dim SearchStr As String
Log "Call Data_GM_FindItem([" & ByteArrayToStr(rBuf.Get_Buffer) & "]," & UserIndex & ")", CodeTracker '//\\LOGLINE//\\
'Get the search string SearchStr = rBuf.Get_String
'Check for invalid values
If UserList(UserIndex).Flags.GMLevel = 0 Then Exit Sub
'Make the search query
DB_RS.Open "SELECT name,id FROM objects WHERE name LIKE '%" & SearchStr & "%'", DB_Conn, adOpenStatic, adLockOptimistic
'Check if we have results or not
If DB_RS.EOF Then
'No results found
If ConBuf.HasBuffer = 0 Then
ConBuf.PreAllocate 25 + Len(SearchStr)
ConBuf.Put_Byte DataCode.Comm_Talk
ConBuf.Put_String "No results found for |" & SearchStr & "|!"
ConBuf.Put_Byte DataCode.Comm_FontType_Info
End If
Else
'Result header
ConBuf.PreAllocate 18 + Len(SearchStr)
ConBuf.Put_Byte DataCode.Comm_Talk
ConBuf.Put_String "Results for |" & SearchStr & "|:"
ConBuf.Put_Byte DataCode.Comm_FontType_Info
'Return the results
Do While Not DB_RS.EOF
ConBuf.Allocate 5 + Len(DB_RS!id) + Len(DB_RS!Name)
ConBuf.Put_Byte DataCode.Comm_Talk
ConBuf.Put_String DB_RS!id & ": " & DB_RS!Name
ConBuf.Put_Byte DataCode.Comm_FontType_Info
DB_RS.MoveNext
Loop
DB_RS.Close
End If
'Send the results
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End Sub </vb>
Open GameClient.vbp.
Find:
<vb>
ElseIf Input_GetCommand("/RAISE") Then
</vb>
Before, add:
<vb>
ElseIf Input_GetCommand("/SEARCHI") Or Input_GetCommand("/FINDI") Or Input_GetCommand("/FINDO") Or Input_GetCommand("/SEARCHO") Then
s = Input_GetBufferArgs
If s = vbNullString Then GoTo CleanUp
sndBuf.Put_Byte DataCode.GM_FindItem
sndBuf.Put_String s
</vb>
Change - Trade completion messages
Replace the message files in \Data\Messages\ with those from v1.0.5 (english.ini and _nummessages.ini required, rest is optional).
Open GameServer.vbp.
Find:
<vb> Private Sub TradeTable_Finish(ByVal TradeTableIndex As Byte) </vb>
Replace whole sub with:
<vb> Private Sub TradeTable_Finish(ByVal TradeTableIndex As Byte)
'***************************************************************** 'Ends a trade table with a successful trade '***************************************************************** Dim i As Long
'Send the "successful trade" message Data_Send ToIndex, TradeTable(TradeTableIndex).User1, cMessage(132).Data() Data_Send ToIndex, TradeTable(TradeTableIndex).User2, cMessage(132).Data()
'Give user 1 their items and gold
For i = 1 To 9
'Check if the trade table slot has an object
If TradeTable(TradeTableIndex).Objs2(i).UserInvSlot > 0 Then
'Give user 1 the object
User_GiveObj TradeTable(TradeTableIndex).User1, UserList(TradeTable(TradeTableIndex).User2).Object(TradeTable(TradeTableIndex).Objs2(i).UserInvSlot).ObjIndex, TradeTable(TradeTableIndex).Objs2(i).Amount, False
'Lower user2's object count
With UserList(TradeTable(TradeTableIndex).User2).Object(TradeTable(TradeTableIndex).Objs2(i).UserInvSlot)
'If they traded all of their items in that slot, remove the object, elsewise just lower the count
If .Amount <= TradeTable(TradeTableIndex).Objs2(i).Amount Then
'Unequip the object from user2 if they have it equipped
User_RemoveInvItem TradeTable(TradeTableIndex).User2, TradeTable(TradeTableIndex).Objs2(i).UserInvSlot, False
'Delete the item from the user's inventory
.Amount = 0
.ObjIndex = 0
.Equipped = 0
Else
'Just lower their amount count
.Amount = .Amount - TradeTable(TradeTableIndex).Objs2(i).Amount
End If
End With
End If
Next i
'Raise user 1's gold count, and lower user 2's
UserList(TradeTable(TradeTableIndex).User1).Stats.BaseStat(SID.Gold) = UserList(TradeTable(TradeTableIndex).User1).Stats.BaseStat(SID.Gold) + TradeTable(TradeTableIndex).Gold2
UserList(TradeTable(TradeTableIndex).User2).Stats.BaseStat(SID.Gold) = UserList(TradeTable(TradeTableIndex).User2).Stats.BaseStat(SID.Gold) - TradeTable(TradeTableIndex).Gold2
'Do the same process, but the other way around, for user 2 to get their stuff
For i = 1 To 9
If TradeTable(TradeTableIndex).Objs1(i).UserInvSlot > 0 Then
User_GiveObj TradeTable(TradeTableIndex).User2, UserList(TradeTable(TradeTableIndex).User1).Object(TradeTable(TradeTableIndex).Objs1(i).UserInvSlot).ObjIndex, TradeTable(TradeTableIndex).Objs1(i).Amount, False
With UserList(TradeTable(TradeTableIndex).User1).Object(TradeTable(TradeTableIndex).Objs1(i).UserInvSlot)
If .Amount <= TradeTable(TradeTableIndex).Objs1(i).Amount Then
User_RemoveInvItem TradeTable(TradeTableIndex).User1, TradeTable(TradeTableIndex).Objs1(i).UserInvSlot, False
.ObjIndex = 0
.Amount = 0
.Equipped = 0
Else
.Amount = .Amount - TradeTable(TradeTableIndex).Objs1(i).Amount
End If
End With
End If
Next i
UserList(TradeTable(TradeTableIndex).User2).Stats.BaseStat(SID.Gold) = UserList(TradeTable(TradeTableIndex).User2).Stats.BaseStat(SID.Gold) + TradeTable(TradeTableIndex).Gold1
UserList(TradeTable(TradeTableIndex).User1).Stats.BaseStat(SID.Gold) = UserList(TradeTable(TradeTableIndex).User1).Stats.BaseStat(SID.Gold) - TradeTable(TradeTableIndex).Gold1
'Send the "you got gold" and "you lost gold" messages
If TradeTable(TradeTableIndex).Gold1 > 0 Then
ConBuf.PreAllocate 6
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 139
ConBuf.Put_Long TradeTable(TradeTableIndex).Gold1
Data_Send ToIndex, TradeTable(TradeTableIndex).User1, ConBuf.Get_Buffer
ConBuf.PreAllocate 6
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 138
ConBuf.Put_Long TradeTable(TradeTableIndex).Gold1
Data_Send ToIndex, TradeTable(TradeTableIndex).User2, ConBuf.Get_Buffer
End If
If TradeTable(TradeTableIndex).Gold2 > 0 Then
ConBuf.PreAllocate 6
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 139
ConBuf.Put_Long TradeTable(TradeTableIndex).Gold2
Data_Send ToIndex, TradeTable(TradeTableIndex).User2, ConBuf.Get_Buffer
ConBuf.PreAllocate 6
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 138
ConBuf.Put_Long TradeTable(TradeTableIndex).Gold2
Data_Send ToIndex, TradeTable(TradeTableIndex).User1, ConBuf.Get_Buffer
End If
'Force a full inventory update
User_UpdateInv True, TradeTable(TradeTableIndex).User1, 0
User_UpdateInv True, TradeTable(TradeTableIndex).User2, 0
'Close the table
TradeTable_Close TradeTableIndex
End Sub </vb>
Open GameClient.vbp.
Find:
<vb>
Case 137
Engine_AddToChatTextBuffer Message(137), FontColor_Info
</vb>
After, add:
<vb>
Case 138
Lng1 = rBuf.Get_Long
Engine_AddToChatTextBuffer Replace$(Message(138), "<amount>", Lng1), FontColor_Info
Case 139
Lng1 = rBuf.Get_Long
Engine_AddToChatTextBuffer Replace$(Message(139), "<amount>", Lng1), FontColor_Info
</vb>
Add - Wings to map editor
Open EditorMap.vbp.
Find:
<vb> Sub Engine_Char_Make(ByVal CharIndex As Integer, ByVal Body As Integer, ByVal Head As Integer, ByVal Heading As Byte, ByVal X As Integer, ByVal Y As Integer, ByVal Name As String, ByVal Weapon As Integer, ByVal Hair As Integer, ByVal NPCNumber As Integer) </vb>
Replace with:
<vb> Sub Engine_Char_Make(ByVal CharIndex As Integer, ByVal Body As Integer, ByVal Head As Integer, ByVal Heading As Byte, ByVal X As Integer, ByVal Y As Integer, ByVal Name As String, ByVal Weapon As Integer, ByVal Hair As Integer, ByVal Wings As Integer, ByVal NPCNumber As Integer) </vb>
Find:
<vb>
CharList(CharIndex).Weapon = WeaponData(Weapon)
</vb>
After, add:
<vb>
CharList(CharIndex).Wings = WingData(Wings)
</vb>
Find:
<vb>
Engine_Char_Make NextOpenCharIndex, DB_RS!char_body, DB_RS!char_head, DB_RS!char_heading, tX, tY, Trim$(DB_RS!Name), DB_RS!char_weapon, DB_RS!char_hair, DB_RS!id
</vb>
Replace with:
<vb>
Engine_Char_Make NextOpenCharIndex, DB_RS!char_body, DB_RS!char_head, DB_RS!char_heading, tX, tY, Trim$(DB_RS!Name), DB_RS!char_weapon, DB_RS!char_hair, DB_RS!char_wings, DB_RS!id
</vb>
Find:
<vb>
Engine_Char_Make NextOpenCharIndex, DB_RS!char_body, DB_RS!char_head, DB_RS!char_heading, X, Y, Trim$(DB_RS!Name), DB_RS!char_weapon, DB_RS!char_hair, DB_RS!id
</vb>
Replace with:
<vb>
Engine_Char_Make NextOpenCharIndex, DB_RS!char_body, DB_RS!char_head, DB_RS!char_heading, X, Y, Trim$(DB_RS!Name), DB_RS!char_weapon, DB_RS!char_hair, DB_RS!char_wings, DB_RS!id
</vb>
Find:
<vb>
DB_RS.Open "SELECT id,char_body,char_hair,char_head,char_heading,name,char_weapon,char_hair FROM npcs WHERE id=" & TempInt, DB_Conn, adOpenStatic, adLockOptimistic
</vb>
Replace with:
<vb>
DB_RS.Open "SELECT * FROM npcs WHERE id=" & TempInt, DB_Conn, adOpenStatic, adLockOptimistic
</vb>
Find:
<vb>
DB_RS.Open "SELECT id,char_body,char_hair,char_head,char_heading,name,char_weapon,char_hair FROM npcs WHERE id=" & frmNPCs.NPCList.ListIndex + 1, DB_Conn, adOpenStatic, adLockOptimistic
</vb>
Replace with:
<vb>
DB_RS.Open "SELECT * FROM npcs WHERE id=" & frmNPCs.NPCList.ListIndex + 1, DB_Conn, adOpenStatic, adLockOptimistic
</vb>
Add - Map editor invalid texture message
Open EditorMap.vbp.
Find:
<vb>
FilePath = GrhPath & TextureNum & ".png"
</vb>
After, add:
<vb>
'Check if the texture exists
If Engine_FileExist(FilePath, vbNormal) = False Then
MsgBox "Error! Could not find the following texture file:" & vbNewLine & FilePath, vbOKOnly
IsUnloading = 1
Exit Sub
End If
</vb>
Fix - Map editor Grh category reading
Open EditorMap.vbp.
Find:
<vb>
'Get the category information
FileNum = FreeFile
Open Data2Path & "GrhRaw.txt" For Input As #FileNum
Do While EOF(FileNum) = False
Line Input #FileNum, j
If LenB(j) <> 0 Then
If InStr(1, j, "(") Then
If InStr(1, j, "=") Then
'Get the category flags
TempSplit = Split(j, "(")
Frame = Val(Left$(TempSplit(1), Len(TempSplit(1)) - 1))
'Get the Grh
TempSplit = Split(j, "=")
Grh = Val(Right$(TempSplit(0), Len(TempSplit(0)) - 3))
'Store
GrhCatFlags(Grh) = Frame
End If
End If
End If
Loop
Close #FileNum
</vb>
Replace with:
<vb>
'Get the category information
FileNum = FreeFile
Open Data2Path & "GrhRaw.txt" For Input As #FileNum
Do While EOF(FileNum) = False
Line Input #FileNum, j
If LenB(j) <> 0 Then
If UCase$(Left$(1, 3)) = "GRH" Then
If InStr(1, j, "(") Then
If InStr(1, j, "=") Then
'Get the Grh
TempSplit = Split(j, "=")
Grh = Val(Right$(TempSplit(0), Len(TempSplit(0)) - 3))
'Check for a valid Grh
If Grh > 0 Then
If Grh <= NumGrhs Then
'Get the category flags
TempSplit = Split(j, "(")
Frame = Val(Left$(TempSplit(1), Len(TempSplit(1)) - 1))
'Store
GrhCatFlags(Grh) = Frame
End If
End If
End If
End If
End If
End If
Loop
Close #FileNum
</vb>
Fix - Better NPC stat updating
Open GameServer.vbp.
In sub NPCs, add:
<vb> Public Sub NPC_ChangeMP(ByVal NPCIndex As Integer, ByVal RaiseBy As Long)
'***************************************************************** 'Chage a NPC's MP - ONLY USE THIS SUB TO CHANGE NPC MP 'Make RaiseBy positive for adding MP, and negative to take MP '***************************************************************** Dim MPA As Byte Dim MPB As Byte
'Get the MP percentage before changing MPA = CByte((NPCList(NPCIndex).BaseStat(SID.MinMAN) / NPCList(NPCIndex).ModStat(SID.MaxMAN)) * 100)
'Raise the MP NPCList(NPCIndex).BaseStat(SID.MinMAN) = NPCList(NPCIndex).BaseStat(SID.MinMAN) + RaiseBy 'Don't go over the limit If NPCList(NPCIndex).BaseStat(SID.MinMAN) > NPCList(NPCIndex).ModStat(SID.MaxMAN) Then NPCList(NPCIndex).BaseStat(SID.MinMAN) = NPCList(NPCIndex).ModStat(SID.MaxMAN) If NPCList(NPCIndex).BaseStat(SID.MinMAN) < 0 Then NPCList(NPCIndex).BaseStat(SID.MinMAN) = 0
'Check to update health percentage client-side
If NPCList(NPCIndex).BaseStat(SID.MinMAN) > 0 Then
MPB = CByte((NPCList(NPCIndex).BaseStat(SID.MinHP) / NPCList(NPCIndex).ModStat(SID.MaxHP)) * 100)
If MPA <> MPB Then
ConBuf.PreAllocate 4
ConBuf.Put_Byte DataCode.Server_CharMP
ConBuf.Put_Byte MPB
ConBuf.Put_Integer NPCList(NPCIndex).Char.CharIndex
Data_Send ToMap, NPCIndex, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map, PP_StatPercent
End If
Else
ConBuf.PreAllocate 4
ConBuf.Put_Byte DataCode.Server_CharMP
ConBuf.Put_Byte 0
ConBuf.Put_Integer NPCList(NPCIndex).Char.CharIndex
Data_Send ToMap, NPCIndex, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map, PP_StatPercent
End If
End Sub </vb>
Find:
<vb> Public Sub NPC_Heal(ByVal NPCIndex As Integer, ByVal Value As Long) </vb>
Replace with:
<vb> Public Sub NPC_Heal(ByVal NPCIndex As Integer, ByVal Value As Long)
'***************************************************************** 'Raise a NPC's HP - ONLY USE THIS SUB TO RAISE NPC HP '***************************************************************** Dim HPA As Byte Dim HPB As Byte
'Get the pre-healing percentage HPA = CByte((NPCList(NPCIndex).BaseStat(SID.MinHP) / NPCList(NPCIndex).ModStat(SID.MaxHP)) * 100)
'Raise the HP NPCList(NPCIndex).BaseStat(SID.MinHP) = NPCList(NPCIndex).BaseStat(SID.MinHP) + Value 'Don't go over the limit If NPCList(NPCIndex).BaseStat(SID.MinHP) > NPCList(NPCIndex).ModStat(SID.MaxHP) Then NPCList(NPCIndex).BaseStat(SID.MinHP) = NPCList(NPCIndex).ModStat(SID.MaxHP)
'Check to update health percentage client-side
If NPCList(NPCIndex).BaseStat(SID.MinHP) > 0 Then
HPB = CByte((NPCList(NPCIndex).BaseStat(SID.MinHP) / NPCList(NPCIndex).ModStat(SID.MaxHP)) * 100)
If HPA <> HPB Then
ConBuf.PreAllocate 4
ConBuf.Put_Byte DataCode.Server_CharHP
ConBuf.Put_Byte HPB
ConBuf.Put_Integer NPCList(NPCIndex).Char.CharIndex
Data_Send ToMap, NPCIndex, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map, PP_StatPercent
End If
Else
ConBuf.PreAllocate 4
ConBuf.Put_Byte DataCode.Server_CharHP
ConBuf.Put_Byte 0
ConBuf.Put_Integer NPCList(NPCIndex).Char.CharIndex
Data_Send ToMap, NPCIndex, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map, PP_StatPercent
End If
End Sub </vb>
Find:
<vb>
NPCList(NPCIndex).BaseStat(SID.MinHP) = NPCList(NPCIndex).BaseStat(SID.MinHP) - Damage
</vb>
Between this line and the following line:
<vb>
'Display the damage on the client screen
</vb>
Replace all of that code between those two lines with:
<vb>
'Check to update health percentage client-side
If NPCList(NPCIndex).BaseStat(SID.MinHP) > 0 Then
HPB = CByte((NPCList(NPCIndex).BaseStat(SID.MinHP) / NPCList(NPCIndex).ModStat(SID.MaxHP)) * 100)
If HPA <> HPB Then
ConBuf.PreAllocate 4
ConBuf.Put_Byte DataCode.Server_CharHP
ConBuf.Put_Byte HPB
ConBuf.Put_Integer NPCList(NPCIndex).Char.CharIndex
Data_Send ToMap, NPCIndex, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map, PP_StatPercent
End If
Else
ConBuf.PreAllocate 4
ConBuf.Put_Byte DataCode.Server_CharHP
ConBuf.Put_Byte 0
ConBuf.Put_Integer NPCList(NPCIndex).Char.CharIndex
Data_Send ToMap, NPCIndex, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map, PP_StatPercent
End If
</vb>
Find:
<vb>
NPCList(CasterIndex).BaseStat(SID.MinMAN) = NPCList(CasterIndex).BaseStat(SID.MinMAN) - Int(NPCList(CasterIndex).ModStat(SID.Mag) * Pro_Cost)
</vb>
Replace with:
<vb>
NPC_ChangeMP CasterIndex, -Int(NPCList(CasterIndex).ModStat(SID.Mag) * Pro_Cost)
</vb>
Find:
<vb>
NPCList(CasterIndex).BaseStat(SID.MinMAN) = NPCList(CasterIndex).BaseStat(SID.MinMAN) - Int(NPCList(CasterIndex).ModStat(SID.Mag) * Str_Cost)
</vb>
Replace with:
<vb>
NPC_ChangeMP CasterIndex, -Int(NPCList(CasterIndex).ModStat(SID.Mag) * Str_Cost)
</vb>
Find:
<vb>
NPCList(CasterIndex).BaseStat(SID.MinMAN) = NPCList(CasterIndex).BaseStat(SID.MinMAN) - Int(NPCList(CasterIndex).ModStat(SID.Mag) * Bless_Cost)
</vb>
Replace with:
<vb>
NPC_ChangeMP CasterIndex, -Int(NPCList(CasterIndex).ModStat(SID.Mag) * Bless_Cost)
</vb>
Find:
<vb> NPCList(CasterIndex).BaseStat(SID.MinMAN) = NPCList(CasterIndex).BaseStat(SID.MinMAN) - Int(NPCList(CasterIndex).ModStat(SID.Mag) * Heal_Cost) </vb>
Replace with:
<vb> NPC_ChangeMP CasterIndex, -Int(NPCList(CasterIndex).ModStat(SID.Mag) * Heal_Cost) </vb>
Fix - Right-clicking window priority
Open GameClient.vbp.
Find:
<vb>
'Start with the last clicked window, then move in order of importance
</vb>
After, add:
<vb>
If Input_Mouse_RightClick_Window(LastClickedWindow) = 1 Then Exit Sub
</vb>