Upgrade 1.0.6 to 1.0.7
From VbGORE Visual Basic Online RPG Engine
This guide will lead you through how to upgrade Version 1.0.6 to Version 1.0.7. For help, please refer to the How to upgrade article. It is highly recommended you read it before ever upgrading.
Add - Map Capture tool
Copy the Map Capture tool from the 3rd Party Tools folder in v1.0.7.
Change - GrhDatMaker error message
Open ToolGrhDatMaker.vbp.
Find:
<vb> ErrorHandler: </vb>
Between that line, and this line:
<vb> End Sub </vb>
Replace all of that code with:
<vb> Dim Loc1 As Long Dim Loc2 As Long
Loc1 = Loc(1) Loc2 = Loc(2) Close #2 Close #1 MsgBox "Error on Grh" & Grh & "!" & vbNewLine & vbNewLine & "Last GrhRaw.txt line: " & Loc2 & vbNewLine & "Last Grh.Dat line: " & Loc1, vbOKOnly Or vbCritical
</vb>
Fix - GrhRawAssistant
Replace GrhRawAssistant with that from v1.0.7.
Add - Valid file number check to GrhDatMaker
Open ToolGrhDatMaker.vbp.
Find:
<vb>
If IsNumeric(Left$(TempSplit(UBound(TempSplit)), Len(TempSplit(UBound(TempSplit))) - 4)) Then
</vb>
After, add:
<vb>
If Val(Left$(TempSplit(UBound(TempSplit)), Len(TempSplit(UBound(TempSplit))) - 4)) > 32767 Then
MsgBox "The following texture file was found with a number higher than 32767:" & vbNewLine & _
FileList(FileNum) & vbNewLine & vbNewLine & "You may not use file numbers higher than 32767." & vbNewLine & _
"This is for performance reasons, and highly recommended not to try and add support for!", vbOKOnly
End
End If
</vb>
Fix - Extra character on quick-reply
Open GameClient.vbp.
At the top of module Input, in the Declares section, add:
<vb> Private IgnoreNextChatKey As Boolean 'Used to ignore the next keystroke going into the chat buffer (for pressing the quick-reply button) </vb>
Find:
<vb>
If EnterText Then
'Backspace
If KeyAscii = 8 Then
If Len(EnterTextBuffer) > 0 Then EnterTextBuffer = Left$(EnterTextBuffer, Len(EnterTextBuffer) - 1)
b = True
End If
'Add to text buffer
If Game_ValidCharacter(KeyAscii) Then
If Len(EnterTextBuffer) < 85 Then
If Game_ValidCharacter(KeyAscii) Then
EnterTextBuffer = EnterTextBuffer & Chr$(KeyAscii)
b = True
End If
End If
End If
'Update size
If b Then
EnterTextBufferWidth = Engine_GetTextWidth(EnterTextBuffer)
UpdateShownTextBuffer
LastClickedWindow = 0
End If
End If
</vb>
Replace with:
<vb>
If EnterText Then
'Check if to ignore this keystroke
If IgnoreNextChatKey Then
IgnoreNextChatKey = False
Else
'Backspace
If KeyAscii = 8 Then
If Len(EnterTextBuffer) > 0 Then EnterTextBuffer = Left$(EnterTextBuffer, Len(EnterTextBuffer) - 1)
b = True
End If
'Add to text buffer
If Game_ValidCharacter(KeyAscii) Then
If Len(EnterTextBuffer) < 85 Then
If Game_ValidCharacter(KeyAscii) Then
EnterTextBuffer = EnterTextBuffer & Chr$(KeyAscii)
b = True
End If
End If
End If
'Update size
If b Then
EnterTextBufferWidth = Engine_GetTextWidth(EnterTextBuffer)
UpdateShownTextBuffer
LastClickedWindow = 0
End If
End If
End If
</vb>
Find:
<vb>
If Input_Keys_IsPressed(KeyDefinitions.QuickReply, KeyCode) Then
If LenB(LastWhisperName) <> 0 Then
</vb>
After, add:
<vb>
IgnoreNextChatKey = True
</vb>
Fix - Server_PlaySound packet
Open GameClient.vbp.
Find:
<vb> Sub Data_Server_PlaySound(ByRef rBuf As DataBuffer) </vb>
Replace sub with:
<vb> Sub Data_Server_PlaySound(ByRef rBuf As DataBuffer)
'********************************************* 'Play a wave file '<WaveNum(B)> '********************************************* Dim WaveNum As Byte
WaveNum = rBuf.Get_Byte
'Check that we are using sounds
If UseSfx = 0 Then Exit Sub
'Create the buffer if needed
If SoundBufferTimer(WaveNum) < timeGetTime Then
If DSBuffer(WaveNum) Is Nothing Then Sound_Set DSBuffer(WaveNum), WaveNum
End If
'Update the timer
SoundBufferTimer(WaveNum) = timeGetTime + SoundBufferTimerMax
Sound_Play DSBuffer(WaveNum), DSBPLAY_DEFAULT
End Sub </vb>
Find:
<vb> Public Sub Sound_Play(ByRef SoundBuffer As DirectSoundSecondaryBuffer8, Optional ByVal flags As CONST_DSBPLAYFLAGS = DSBPLAY_DEFAULT) </vb>
Replace sub with:
<vb> Public Sub Sound_Play(ByRef SoundBuffer As DirectSoundSecondaryBuffer8, Optional ByVal flags As CONST_DSBPLAYFLAGS = DSBPLAY_DEFAULT) '************************************************************ 'Used for non area-specific sound effects, such as weather '************************************************************
'Make sure we are using sound If UseSfx = 0 Then Exit Sub
'Confirm the buffer exists
If Not SoundBuffer Is Nothing Then
'Reset the sounds values (in case they were ever changed)
SoundBuffer.SetCurrentPosition 0
Sound_Pan SoundBuffer, 0
Sound_Volume SoundBuffer, 0
'Play the sound
SoundBuffer.Play flags
End If
End Sub </vb>
Add - Update client host name support
Open UpdateClient.vbp.
In module General, find:
<vb> Private Sub CommandLine(ByVal CommandLineString As String) </vb>
Before, add:
<vb>
Private Type typHOSTENT
hName As Long hAliases As Long hAddrType As Integer hLength As Integer hAddrList As Long
End Type
Private Type WSADATA
wversion As Integer wHighVersion As Integer szDescription(0 To 255) As Byte szSystemStatus(0 To 127) As Byte iMaxSockets As Integer iMaxUdpDg As Integer lpszVendorInfo As Long
End Type
Private Declare Sub apiCopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long) Private Declare Function apiGetHostByName Lib "wsock32" Alias "gethostbyname" (ByVal HostName As String) As Long Private Declare Function WSACleanup Lib "wsock32" () As Long Private Declare Function WSAStartup Lib "wsock32" (ByVal VersionReq As Long, WSADataReturn As WSADATA) As Long
Private Function IsIP(ByVal IPAddress As String) As Boolean Dim s() As String Dim i As Long
'If there are no periods, I have no idea what we have...
If InStr(1, IPAddress, ".") = 0 Then Exit Function
'Split up the string by the periods
s = Split(IPAddress, ".")
'Confirm we have ubound = 3, since xxx.xxx.xxx.xxx has 4 elements and we start at index 0
If UBound(s) <> 3 Then Exit Function
'Check that the values are numeric and in a valid range
For i = 0 To 3
If Val(s(i)) < 0 Then Exit Function
If Val(s(i)) > 255 Then Exit Function
Next i
'Looks like we were passed a valid IP!
IsIP = True
End Function
Public Function GetIPFromHost(ByVal HostName As String) As String Dim udtWSAData As WSADATA Dim HostAddress As Long Dim HostInfo As typHOSTENT Dim IPLong As Long Dim IPBytes() As Byte Dim i As Integer
On Error Resume Next
If WSAStartup(257, udtWSAData) Then
MsgBox "Error initializing winsock on WSAStartup!"
GetIPFromHost = HostName
Exit Function
End If
'Make sure a HTTP:// or FTP:// something wasn't added... some people like to do that
If UCase$(Left$(HostName, 7)) = "HTTP://" Then
HostName = Right$(HostName, Len(HostName) - 7)
ElseIf UCase$(Left$(HostName, 6)) = "FTP://" Then
HostName = Right$(HostName, Len(HostName) - 6)
End If
'If we were already passed an IP, just abort since we have what we want
If IsIP(HostName) Then
GetIPFromHost = HostName
Exit Function
End If
'Get the host address
HostAddress = apiGetHostByName(HostName)
'Failure!
If HostAddress = 0 Then Exit Function
'Move the memory around to get it in a format we can read
apiCopyMemory HostInfo, HostAddress, LenB(HostInfo)
apiCopyMemory IPLong, HostInfo.hAddrList, 4
'Get the number of parts to the IP (will always be 4 as far as I know)
ReDim IPBytes(1 To HostInfo.hLength)
'Convert the address, stored in the format of a long, to 4 bytes (just simple long -> byte array conversion)
apiCopyMemory IPBytes(1), IPLong, HostInfo.hLength
'Add in the periods
For i = 1 To HostInfo.hLength
GetIPFromHost = GetIPFromHost & IPBytes(i) & "."
Next
'Remove the final period
GetIPFromHost = Left$(GetIPFromHost, Len(GetIPFromHost) - 1)
'Clean up the socket
WSACleanup
End Function </vb>
Find:
<vb>
LocalID = GOREsock_Connect("127.0.0.1", 10201)
</vb>
Replace with:
<vb>
LocalID = GOREsock_Connect(GetIPFromHost("127.0.0.1"), 10201)
</vb>
Add - Map version auto-increment
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 - Small map editor issues
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 - NPC_Close
Open GameServer.vbp.
Find:
<vb>
'Close down the NPC CharList(NPCList(NPCIndex).Char.CharIndex).Index = 0 CharList(NPCList(NPCIndex).Char.CharIndex).CharType = 0
</vb>
Replace with:
<vb>
'Close down the NPC NPCList(NPCIndex).Flags.NPCActive = 0 CharList(NPCList(NPCIndex).Char.CharIndex).Index = 0 CharList(NPCList(NPCIndex).Char.CharIndex).CharType = 0
</vb>
Change - Motion blur state check
Open GameClient.vbp.
Find:
<vb> Sub Engine_Render_Screen(ByVal TileX As Integer, ByVal TileY As Integer, ByVal PixelOffsetX As Integer, ByVal PixelOffsetY As Integer) </vb>
At the top of the sub, add:
<vb> Dim FrameUseMotionBlur As Boolean 'Lets us know if this frame is using motion blur so we don't have to leave support for it on </vb>
Find:
<vb>
'Set the motion blur if needed
If UseMotionBlur Then
D3DDevice.SetRenderTarget BlurSurf, BlurStencil, 0
End If
</vb>
Replace with:
<vb>
'Set the motion blur if needed
If UseMotionBlur Then
If BlurIntensity < 255 Or ZoomLevel > 0 Then
FrameUseMotionBlur = True
D3DDevice.SetRenderTarget BlurSurf, BlurStencil, 0
End If
End If
</vb>
Find:
<vb>
With D3DDevice
'Check if using motion blur / zooming
If UseMotionBlur Then
'Perform the zooming calculations
' * 1.333... maintains the aspect ratio
' ... / 1024 is to factor in the buffer size
BlurTA(0).tU = ZoomLevel * 1.333333333
BlurTA(0).tV = ZoomLevel
BlurTA(1).tU = ((ScreenWidth + 1) / 1024) - (ZoomLevel * 1.333333333)
BlurTA(1).tV = ZoomLevel
BlurTA(2).tU = ZoomLevel * 1.333333333
BlurTA(2).tV = ((ScreenHeight + 1) / 1024) - ZoomLevel
BlurTA(3).tU = BlurTA(1).tU
BlurTA(3).tV = BlurTA(2).tV
'Draw what we have drawn thus far since the last .Clear
LastTexture = -100
.SetRenderTarget DeviceBuffer, DeviceStencil, 0
.SetTexture 0, BlurTexture
.SetRenderState D3DRS_TEXTUREFACTOR, D3DColorARGB(BlurIntensity, 255, 255, 255)
.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TFACTOR
.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, BlurTA(0), FVF_Size
.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE
End If
End With
</vb>
Replace with:
<vb>
'Check if using motion blur / zooming
If UseMotionBlur Then
If FrameUseMotionBlur Then
With D3DDevice
'Perform the zooming calculations
' * 1.333... maintains the aspect ratio
' ... / 1024 is to factor in the buffer size
BlurTA(0).tU = ZoomLevel * 1.333333333
BlurTA(0).tV = ZoomLevel
BlurTA(1).tU = ((ScreenWidth + 1) / 1024) - (ZoomLevel * 1.333333333)
BlurTA(1).tV = ZoomLevel
BlurTA(2).tU = ZoomLevel * 1.333333333
BlurTA(2).tV = ((ScreenHeight + 1) / 1024) - ZoomLevel
BlurTA(3).tU = BlurTA(1).tU
BlurTA(3).tV = BlurTA(2).tV
'Draw what we have drawn thus far since the last .Clear
LastTexture = -100
.SetRenderTarget DeviceBuffer, DeviceStencil, 0
.SetTexture 0, BlurTexture
.SetRenderState D3DRS_TEXTUREFACTOR, D3DColorARGB(BlurIntensity, 255, 255, 255)
.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TFACTOR
.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, BlurTA(0), FVF_Size
.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE
End With
End If
End If
</vb>