Upgrade 1.0.6 to 1.0.7

From VbGORE Visual Basic Online RPG Engine

Contents

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>

Personal tools