Upgrade 1.0.6 to 1.0.7

From VbGORE Visual Basic Online RPG Engine

Contents 1 Add - Map Capture tool 2 Change - GrhDatMaker error message 3 Fix - GrhRawAssistant 4 Add - Valid file number check to GrhDatMaker 5 Fix - Extra character on quick-reply 6 Fix - Server_PlaySound packet 7 Add - Update client host name support 8 Add - Map version auto-increment 9 Fix - Small map editor issues 10 Fix - NPC_Close 11 Change - Motion blur state check

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.

[edit] Add - Map Capture tool

Copy the Map Capture tool from the 3rd Party Tools folder in v1.0.7.

[edit] Change - GrhDatMaker error message

Open ToolGrhDatMaker.vbp.

Find:

ErrorHandler:

Between that line, and this line:

End Sub

Replace all of that code with:

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

[edit] Fix - GrhRawAssistant

Replace GrhRawAssistant with that from v1.0.7.

[edit] Add - Valid file number check to GrhDatMaker

Open ToolGrhDatMaker.vbp.

Find:

            If IsNumeric(Left$(TempSplit(UBound(TempSplit)), Len(TempSplit(UBound(TempSplit))) - 4)) Then

After, add:

                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

[edit] Fix - Extra character on quick-reply

Open GameClient.vbp.

At the top of module Input, in the Declares section, add:

Private IgnoreNextChatKey As Boolean    'Used to ignore the next keystroke going into the chat buffer (for pressing the quick-reply button)

Find:

        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

Replace with:

        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

Find:

    If Input_Keys_IsPressed(KeyDefinitions.QuickReply, KeyCode) Then
        If LenB(LastWhisperName) <> 0 Then

After, add:

            IgnoreNextChatKey = True

[edit] Fix - Server_PlaySound packet

Open GameClient.vbp.

Find:

Sub Data_Server_PlaySound(ByRef rBuf As DataBuffer)

Replace sub with:

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

Find:

Public Sub Sound_Play(ByRef SoundBuffer As DirectSoundSecondaryBuffer8, Optional ByVal flags As CONST_DSBPLAYFLAGS = DSBPLAY_DEFAULT)

Replace sub with:

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

[edit] Add - Update client host name support

Open UpdateClient.vbp.

In module General, find:

Private Sub CommandLine(ByVal CommandLineString As String)

Before, add:

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

Find:

    LocalID = GOREsock_Connect("127.0.0.1", 10201)

Replace with:

    LocalID = GOREsock_Connect(GetIPFromHost("127.0.0.1"), 10201)

[edit] 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.

[edit] 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.

[edit] Fix - NPC_Close

Open GameServer.vbp.

Find:

    'Close down the NPC
    CharList(NPCList(NPCIndex).Char.CharIndex).Index = 0
    CharList(NPCList(NPCIndex).Char.CharIndex).CharType = 0

Replace with:

    'Close down the NPC
    NPCList(NPCIndex).Flags.NPCActive = 0
    CharList(NPCList(NPCIndex).Char.CharIndex).Index = 0
    CharList(NPCList(NPCIndex).Char.CharIndex).CharType = 0

[edit] Change - Motion blur state check

Open GameClient.vbp.

Find:

Sub Engine_Render_Screen(ByVal TileX As Integer, ByVal TileY As Integer, ByVal PixelOffsetX As Integer, ByVal PixelOffsetY As Integer)

At the top of the sub, add:

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

Find:

    'Set the motion blur if needed
    If UseMotionBlur Then
        D3DDevice.SetRenderTarget BlurSurf, BlurStencil, 0
    End If

Replace with:

    '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

Find:

    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

Replace with:

    '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