From VbGORE Visual Basic Online RPG Engine

Contents 1 Overview 2 SQL Database 2.1 Creating the Guilds Table 2.2 Editing the users Table 3 The Server 3.1 The declares 3.2 The Code 3.2.1 Sub Load_Guilds() 3.2.2 Sub Load_User() 3.2.3 Sub StartServer() 3.2.4 Sub Save_Guilds & Save_Guild 3.2.5 Sub User_MakeChar() 3.2.6 Public Type DataCode 3.2.7 Sub InitDataCommands() 3.2.8 Send Routes 3.2.9 Sub Data_Send() 3.2.10 Adding to Module General 3.2.11 Unfinished Code 3.2.11.1 Data_User_Guild 4 The Client 4.1 Editing the Code 4.1.1 Sub Data_Server_MakeChar(ByRef rBuf As DataBuffer)

Overview

Hey all! Here I will be enlisting a detailed step by step guide on how to add guilds. Here, ALOT need to be edited - it includes

SQL Database
Server
Client

I will split this up into three different sections. First we will go through the SQL Database, then what we need to do on the Server and then finally the Client

I can assure you. THIS WILL NOT BE AN EASY GUIDE NOR A SHORT ONE, YOU MUST HAVE PATIENCE

From the look of things, I think this isn't the fastest method(Well it is still pretty fast), but it works none the less.

However, sorry to say this guide is yet incomplete, functions on client side have not been fully implemented and server side has not been completed 100%

SQL Database

Ok! First of all, this guide is assuming you are using the SQLyog database editor to access your MySQL server.

Creating the Guilds Table

This is an easy task, go to your vbgore database, right click on it and click on "Create table"

You should be given the option to enter the field types. Enter the following in THIS order

<vb> Field Name Data Type Len PK Not Null

id tinyint 6 Yes Yes name varchar 30 Yes msg varchar 1000 Yes owner varchar 20 Yes users text Yes customrank text Yes access text Yes </vb>

it should look like this

[[image::]]

Editing the users Table

We need to edit the users table so we are able to realise that they are apart of a guild

Right click on the table "users" in the vbgore database, and click on "Alter Table"

Scroll down to the bottom and add a new field, guild_id as a smallint with len 4, make sure you tick both unsigned & not null

The Server

Urgh... the dreaded part of it all.

Alot of work is needed here

The declares

Go into the module Declares

and find

<vb> Option Explicit </vb>

after add

<vb> 'Guild information Public Const GUILD_MaxMembers As Byte = 20

Public Type typGUILD_DATA

  CharID as string
  RankName as String
  Access as Byte

End Type

Public Type typGUILD

  Guild_ID as integer
  Data(1 to GUILD_MaxMembers) as typGUILD_DATA
  CreatorID as string
  Msg as string
  InUse as byte
  Guild_Name as string
  SaveNew as byte

End Type

Public Guilds() As typGUILD </vb>

Find Type User 'Holds data for a user

Go down to the bottom of this type, before it says End Type add <vb>

   GuildID As Integer

End Type </vb>

The Code

Sub Load_Guilds()

Open up the module FileIO and add the following code

<vb> Public Sub Load_Guilds()

Dim I As Integer Dim I2 As Integer Dim sp() As String

   Log "Call Load_Guilds()", CodeTracker
   
   DB_RS.Open "SELECT * FROM guilds", DB_Conn, adOpenStatic, adLockOptimistic
   
   Do While Not DB_RS.EOF
       ReDim Preserve Guilds(I)
       Guilds(I).CreatorID = Trim$(DB_RS!owner)
       Guilds(I).Guild_ID = (DB_RS!id) / 1
       Guilds(I).Msg = Trim$(DB_RS!Msg)
       Guilds(I).Guild_Name = Trim$(DB_RS!Name)
       Guilds(I).InUse = 1

       sp = Split(Trim$(DB_RS!Users), vbNewLine)
       For I2 = 0 To UBound(sp)
           Guilds(I).Data(I2 + 1).CharID = sp(I2)
       Next I2
       
       sp = Split(Trim$(DB_RS!customrank), vbNewLine)
       For I2 = 0 To UBound(sp)
           Guilds(I).Data(I2 + 1).RankName = sp(I2)
       Next I2
       
       sp = Split(Trim$(DB_RS!Access), vbNewLine)
       For I2 = 0 To UBound(sp)
           Guilds(I).Data(I2 + 1).RankName = sp(I2)
       Next I2
       
       I = I + 1
       DoEvents
       DB_RS.MoveNext
   Loop

   DB_RS.Close

End Sub

</vb>

Sub Load_User()

Go to module FileIO and find the Sub Load_User(ByVal UserIndex As Integer, ByVal UserName As String)

Find <vb>

       UserList(UserIndex).Stats.ModStat(SID.MaxHP) = UserList(UserIndex).Stats.BaseStat(SID.MaxHP)
       UserList(UserIndex).Stats.ModStat(SID.MaxMAN) = UserList(UserIndex).Stats.BaseStat(SID.MaxMAN)
       UserList(UserIndex).Stats.ModStat(SID.MaxSTA) = UserList(UserIndex).Stats.BaseStat(SID.MaxSTA)

</vb>

and after that add the code

<vb>

        UserList(UserIndex).GuildID = Val(!Guild_ID)

</vb>

Sub StartServer()

Find the sub StartServer located in frmMain

Find the code <vb>

   frmMain.Caption = "Creating npc files..."
   frmMain.Refresh
   Save_NPCs_Temp
   Load_NPC_Names

</vb>

and after Add

<vb>

   frmMain.Caption = "Loading Guilds"
   frmMain.Refresh
   Load_Guilds

</vb>

Sub Save_Guilds & Save_Guild

Add the following code to module FileIO

<vb> Public Sub Save_Guild(Index As Integer)

Dim i As Integer Dim I2 As Integer Dim sp() As String Dim strUsers As String Dim strAccess As String Dim strRank As String

   Log "Call Save_Guild()", CodeTracker
   
   i = Index
       With Guilds(i)
       
       sp = Split(Trim$(DB_RS!Users), vbNewLine)
       For I2 = 1 To GUILD_MaxMembers
           strUsers = strUsers & .Data(I2).CharID & vbNewLine
           strRank = strRank & .Data(I2).RankName & vbNewLine
           strAccess = strAccess & .Data(I2).Access & vbNewLine
       Next I2
              
       If .SaveNew > 0 Then
           DB_RS.Open "SELECT * FROM guilds WHERE 0=1", DB_Conn, adOpenStatic,  adLockOptimistic
           DB_RS.AddNew
       Else
           DB_RS.Open "SELECT * FROM guilds WHERE `name`='" & .Guild_Name & "'", DB_Conn, adOpenStatic, adLockOptimistic
       End If
       
       Guilds(i).InUse = 1
       
       DB_RS!Owner = .CreatorID
       DB_RS!ID = .Guild_ID
       DB_RS!Msg = .Msg
       
       End With
       DB_RS!Users = strUsers
       DB_RS!customrank = strRank
       DB_RS!Access = strAccess

       i = i + 1
       DoEvents
       DB_RS.MoveNext
       DB_RS.Close
   

End Sub

Public Sub Save_Guilds()

Dim i As Integer Dim I2 As Integer Dim sp() As String Dim strUsers As String Dim strAccess As String Dim strRank As String

   Log "Call Save_Guilds()", CodeTracker
   
   For i = 0 To UBound(Guilds)
       With Guilds(i)
       
       sp = Split(Trim$(DB_RS!Users), vbNewLine)
       For I2 = 1 To GUILD_MaxMembers
           strUsers = strUsers & .Data(I2).CharID & vbNewLine
           strRank = strRank & .Data(I2).RankName & vbNewLine
           strAccess = strAccess & .Data(I2).Access & vbNewLine
       Next I2
              
       If .SaveNew > 0 Then
           DB_RS.Open "SELECT * FROM guilds WHERE 0=1", DB_Conn, adOpenStatic, adLockOptimistic
           DB_RS.AddNew
       Else
           DB_RS.Open "SELECT * FROM guilds WHERE `name`='" & .Guild_Name & "'", DB_Conn, adOpenStatic, adLockOptimistic
       End If
       
       Guilds(i).InUse = 1
       
       DB_RS!Owner = .CreatorID
       DB_RS!ID = .Guild_ID
       DB_RS!Msg = .Msg
       
       End With
       DB_RS!Users = strUsers
       DB_RS!customrank = strRank
       DB_RS!Access = strAccess

       i = i + 1
       DoEvents
       DB_RS.MoveNext
       DB_RS.Close
   Next i
   

End Sub </vb>

Sub User_MakeChar()

Go to the module Users, go down to sub User_MakeChar

Find and replace this code

<vb>

   'Send make character command to clients
   ConBuf.PreAllocate 22 + Len(UserList(UserIndex).Name)
   ConBuf.Put_Byte DataCode.Server_MakeChar
   ConBuf.Put_Integer UserList(UserIndex).Char.Body
   ConBuf.Put_Integer UserList(UserIndex).Char.Head
   ConBuf.Put_Byte UserList(UserIndex).Char.Heading
   ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex
   ConBuf.Put_Byte X
   ConBuf.Put_Byte Y
   ConBuf.Put_Byte UserList(UserIndex).Stats.ModStat(SID.Speed)
   ConBuf.Put_String UserList(UserIndex).Name
   ConBuf.Put_Integer UserList(UserIndex).Char.Weapon
   ConBuf.Put_Integer UserList(UserIndex).Char.Hair
   ConBuf.Put_Integer UserList(UserIndex).Char.Wings
   ConBuf.Put_Byte UserList(UserIndex).Stats.LastHPPercent
   ConBuf.Put_Byte UserList(UserIndex).Stats.LastMPPercent
   ConBuf.Put_Byte 0

</vb>

with

<vb>

   'Send make character command to clients
   ConBuf.PreAllocate 24 + Len(UserList(UserIndex).Name)
   ConBuf.Put_Byte DataCode.Server_MakeChar
   ConBuf.Put_Integer UserList(UserIndex).Char.Body
   ConBuf.Put_Integer UserList(UserIndex).Char.Head
   ConBuf.Put_Byte UserList(UserIndex).Char.Heading
   ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex
   ConBuf.Put_Byte X
   ConBuf.Put_Byte Y
   ConBuf.Put_Byte UserList(UserIndex).Stats.ModStat(SID.Speed)
   ConBuf.Put_String UserList(UserIndex).Name
   ConBuf.Put_Integer UserList(UserIndex).Char.Weapon
   ConBuf.Put_Integer UserList(UserIndex).Char.Hair
   ConBuf.Put_Integer UserList(UserIndex).Char.Wings
   ConBuf.Put_Byte UserList(UserIndex).Stats.LastHPPercent
   ConBuf.Put_Byte UserList(UserIndex).Stats.LastMPPercent
   ConBuf.Put_Integer UserList(UserIndex).GuildID
   ConBuf.Put_Byte 0

</vb>

Public Type DataCode

Go into the module DataIDs find <vb>Public Type DataCode</vb>

go down to the bottom of Type DataCode <vb>

   ....
   GM_IPInfo As Byte
   GM_BanList As Byte
   Combo_ProjectileSoundRotateDamage As Byte
   Combo_SoundRotateDamage As Byte
   Combo_SlashSoundRotateDamage As Byte

End Type </vb>

after add

<vb>

   ....
   User_Guild As Byte
   Guild_Make As Byte
   Guild_Destroy As Byte
   Guild_Update_MOTD As Byte
   Guild_Update_UserList As Byte
   Guild_CharLogon As Byte
   Guild_Update_Rank As Byte
   Guild_Kick As Byte
   Guild_Get_Pos As Byte
   Comm_FontType_Guild As Byte

</vb>

so it basicly should look like this

<vb>

   ....
   GM_IPInfo As Byte
   GM_BanList As Byte
   Combo_ProjectileSoundRotateDamage As Byte
   Combo_SoundRotateDamage As Byte
   Combo_SlashSoundRotateDamage As Byte
   User_Guild As Byte
   Guild_Make As Byte
   Guild_Destroy As Byte
   Guild_Update_MOTD As Byte
   Guild_Update_UserList As Byte
   Guild_CharLogon As Byte
   Guild_Update_Rank As Byte
   Guild_Kick As Byte
   Guild_Get_Pos As Byte
   Comm_FontType_Guild As Byte

End Type </vb>

Sub InitDataCommands()

Go to DataIDs and find

<vb> Sub InitDataCommands() </vb>

Find (ctrl + f)

<vb>

   With DataCode

</vb>

then go down and find (just use ctrl + f)

<vb>

       .Server_KeepAlive = 121

</vb>

after add

<vb>

       'Guild stuff
       .User_Guild = 122
       
       'Values which is extension for guild_info
       
       .Guild_Update_MOTD = 1
       .Guild_Update_UserList = 2
       .Guild_CharLogon = 3
       .Guild_Update_Rank = 4
       .Guild_Kick = 5
       .Guild_Get_Pos = 6
       .Guild_Make = 7
       .Comm_FontType_Guild = 6

</vb>

Send Routes

Go to module TCP and find

<vb> Public Const ToGroup As Byte = 9 'Send to all users in a group Public Const ToMapGroupButIndex As Byte = 10 'Send to all users in a group but the userindex that are on the same map Public Const ToPCAreaButIndex As Byte = 11 'Send to all the users in the user's area, but the user themself </vb>

after add

<vb> Public Const ToGuildButIndex As Byte = 12 Public Const ToGuild As Byte = 13 </vb>

Sub Data_Send()

Go to the module TCP and find <vb> Sub Data_Send(ByVal sndRoute As Byte, ByVal sndIndex As Integer, ByRef sndData() As Byte, Optional ByVal sndMap As Integer, Optional ByVal Priority As Long = PP_High) </vb>

find <vb> Case ToNPCMove

           Log "Send ToNPCMove(" & sndIndex & "): " & ByteArrayToStr(sndData), PacketOut '//\\LOGLINE//\\
           sndMap = NPCList(sndIndex).Pos.Map
           If sndMap > 0 Then
               For LoopC = 1 To MapInfo(sndMap).NumUsers
                   tIndex = MapUsers(sndMap).Index(LoopC)
                   If UserList(tIndex).Flags.UserLogged Then
                       If DEBUG_RecordPacketsOut Then DebugPacketsOut(sndData(0)) = DebugPacketsOut(sndData(0)) + 1
                       CopyPos = UserList(tIndex).BufferSize + 1
                       ReDim Preserve UserList(tIndex).SendBuffer(UserList(tIndex).BufferSize + CopySize)
                       CopyMemory UserList(tIndex).SendBuffer(CopyPos), sndData(0), CopySize
                       UserList(tIndex).BufferSize = UserList(tIndex).BufferSize + CopySize
                       If Server_RectDistance(NPCList(sndIndex).Pos.X, NPCList(sndIndex).Pos.Y, UserList(tIndex).Pos.X, UserList(tIndex).Pos.Y, MaxServerDistanceX, MaxServerDistanceY) Then
                           Data_Send_Update tIndex, PP_CloseCharMove
                       Else
                           Data_Send_Update tIndex, PP_FarCharMove
                       End If
                   End If
               Next LoopC
           End If

</vb>

after add <vb>

       Case ToGuild
           If UserList(sndIndex).GuildID > 0 Then
               For LoopC = 1 To UBound(UserList)
                   If UserList(LoopC).Flags.UserLogged Then
                       If UserList(LoopC).GuildID = UserList(sndIndex).GuildID Then
                           If DEBUG_RecordPacketsOut Then DebugPacketsOut(sndData(0)) = DebugPacketsOut(sndData(0)) + 1
                           CopyPos = UserList(LoopC).BufferSize + 1
                           ReDim Preserve UserList(LoopC).SendBuffer(UserList(LoopC).BufferSize + CopySize)
                           CopyMemory UserList(LoopC).SendBuffer(CopyPos), sndData(0), CopySize
                           UserList(LoopC).BufferSize = UserList(LoopC).BufferSize + CopySize
                           Data_Send_Update tIndex, Priority
                       End If
                   End If
               Next LoopC
           End If
   
       Case ToGuildButIndex
           If UserList(sndIndex).GuildID > 0 Then
               For LoopC = 1 To UBound(UserList)
                   If UserList(LoopC).Flags.UserLogged Then
                       If (UserList(LoopC).GuildID = UserList(sndIndex).GuildID) And (LoopC <> sndIndex) Then
                           If DEBUG_RecordPacketsOut Then DebugPacketsOut(sndData(0)) = DebugPacketsOut(sndData(0)) + 1
                           CopyPos = UserList(LoopC).BufferSize + 1
                           ReDim Preserve UserList(LoopC).SendBuffer(UserList(LoopC).BufferSize + CopySize)
                           CopyMemory UserList(LoopC).SendBuffer(CopyPos), sndData(0), CopySize
                           UserList(LoopC).BufferSize = UserList(LoopC).BufferSize + CopySize
                           Data_Send_Update tIndex, Priority
                       End If
                   End If
               Next LoopC
           End If

</vb>

Adding to Module General

Add the following code to the end of the module General <vb> Public Function Guild_FindEmptySlot(GuildIndex As Integer) As Integer Dim I As Integer

   With Guilds(GuildIndex)
       For I = 1 To GUILD_MaxMembers
           If Len(.Data(I).CharID) = 0 Then Exit For
       Next I
       If I > GUILD_MaxMembers Then
           Guild_FindEmptySlot = -1
       Else
           Guild_FindEmptySlot = I
       End If
   End With

End Function

Public Function Guild_Create(GuildName As String, Owner As String) As Boolean Dim ID As Integer Dim e As Integer

   ID = Guild_NewGuildID
   e = Guild_FindEmpty
   If e > UBound(Guilds) Then ReDim Preserve Guilds(e)
           
   With Guilds(e)
       .Guild_ID = ID
       .InUse = 1
       .Msg = "Welcome to" & GuildName
       .CreatorID = Owner
       .Data(1).Access = 1
       .Data(1).CharID = Owner
       .Data(1).RankName = "Owner"
       .Guild_Name = GuildName
       .SaveNew = 1
   End With
   
   End If
   
   Save_Guild e

End Function

Public Function Guild_FindEmpty() As Integer Dim I As Integer

   For I = 0 To UBound(Guilds)
       If Guilds(I).InUse = 0 Then
   Next I
       Guild_FindEmpty = I

End Function

Public Function Guild_NewGuildID() As Integer Dim I As Integer Dim ID As Integer

   Do
       Randomize
       ID = (Rnd * (2 ^ 15)) - 1
       If ID <= 0 Then ID = 1
       For I = 0 To UBound(Guilds)
           If Guilds(I).Guild_ID = ID Then Exit For
       Next I
       If I > UBound(Guilds) Then
           Guild_NewGuildID = ID
           Exit Function
       End If
       DoEvents
   Loop

End Function </vb>

Unfinished Code

Data_User_Guild

NOTE THIS CODE HAS NOT BEEN FULLY FINISHED!!! add the following code to module TCP

<vb> Sub Data_User_Guild(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer) Dim MessageID As Byte Dim small_flag As Byte Dim guild As Integer Dim list_choice As Byte Dim tmpString As String

   guild = UserList(UserIndex).GuildID
   
   If guild = 0 Then Exit Sub
   
   MessageID = rBuf.Get_Byte
               
   
   ConBuf.PreAllocate 0
   ConBuf.Put_Byte DataCode.User_Guild
   
   Select Case MessageID
       Case DataCode.Guild_CharLogon
       Case DataCode.Guild_Destroy
       Case DataCode.Guild_Get_Pos
       Case DataCode.Guild_Kick
       Case DataCode.Guild_Make
       Case DataCode.Guild_Update_MOTD
       
       Case DataCode.Guild_Update_Rank
       ConBuf.Put_Byte DataCode.Guild_Update_Rank
       'When rank is modified or is just request for ranks
           small_flag = rBuf.Get_Byte 'to determine whether we updating list or just request list
           ConBuf.Put_Byte
           If small_flag = 1 Then 'we are updating list
               With Guilds(guild)
                   list_choice = rBuf.Get_Byte
                   .Data(list_choice).CharID = rBuf.Get_String
                   .Data(list_choice).RankName = rBuf.Get_String
                   Save_Guild guild
               
               ConBuf.Put_Byte list_choice
               ConBuf.Put_String .Data(list_choice).RankName
               
               End With
               Data_Send ToGuild, UserIndex, ConBuf.Get_Buffer()
           
           ElseIf small_flag = 2 Then 'we are just requesting list of ranks
                   For list_choice = 1 To GUILD_MaxMembers
                       With Guilds(guild).Data(list_choice)
                           tmpString = tmpString & .RankName & vbNewLine
                       End With
                   Next i
                   ConBuf.Put_String tmpString
               Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
           
           End If
       Case DataCode.Guild_Update_UserList
       ConBuf.Put_Byte DataCode.Guild_Update_UserList
       'When a player invites another to the guild, or we're just retrieving the list
           small_flag = rBuf.Get_Byte
           If small_flag = 1 Then 'we are updating/adding
               ConBuf.Put_Byte 1
               With Guilds(guild)
                list_choice = Guild_FindEmptySlot
                   .Data(list_choice).Access = 0
                   .Data(list_choice).RankName = "newbie"
                   .Data(list_choice).CharID = rBuf.Get_String
                   
                   ConBuf.Put_String .Data(list_choice).CharID
               End With
                   Data_Send ToGuild, UserIndex, ConBuf.Get_Buffer()
           ElseIf small_flag = 2 Then
               ConBuf.Put_Byte 2
               'basicly we just logged on, so we ask for alot and alot of data :(
               With Guilds(guild)
                   ConBuf.Put_Integer.Guild_ID
                   ConBuf.Put_String .CreatorID
                   ConBuf.putstring .Guild_Name
                   ConBuf.Put_String .Msg
                   
                   For list_choice = 1 To GUILD_MaxMembers
                       With .Data(list_choice)
                           ConBuf.Put_Byte .Access
                           ConBuf.Put_String .CharID
                           ConBuf.Put_String .RankName
                       End With
                   Next list_choice
               End With
               
               Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
           End If
           
   End Select

End Sub </vb>

The Client

A bit technical here but w/e

Editing the Code

Sub Data_Server_MakeChar(ByRef rBuf As DataBuffer)

Go to module TCP

find <vb>Sub Data_Server_MakeChar(ByRef rBuf As DataBuffer)</vb>

add

<vb>Dim aGuild As Integer</vb>

after

<vb> Dim Wings As Integer Dim HP As Byte Dim MP As Byte Dim ChatID As Byte Dim CharType As Byte Dim OwnerChar As Integer </vb>

replace code

<vb>

   Body = rBuf.Get_Integer
   Head = rBuf.Get_Integer
   Heading = rBuf.Get_Byte
   CharIndex = rBuf.Get_Integer
   X = rBuf.Get_Byte
   Y = rBuf.Get_Byte
   Speed = rBuf.Get_Byte
   Name = rBuf.Get_String
   Weapon = rBuf.Get_Integer
   Hair = rBuf.Get_Integer
   Wings = rBuf.Get_Integer
   HP = rBuf.Get_Byte
   MP = rBuf.Get_Byte
   ChatID = rBuf.Get_Byte
   CharType = rBuf.Get_Byte

</vb>

with

<vb>

   Body = rBuf.Get_Integer
   Head = rBuf.Get_Integer
   Heading = rBuf.Get_Byte
   CharIndex = rBuf.Get_Integer
   X = rBuf.Get_Byte
   Y = rBuf.Get_Byte
   Speed = rBuf.Get_Byte
   Name = rBuf.Get_String
   Weapon = rBuf.Get_Integer
   Hair = rBuf.Get_Integer
   Wings = rBuf.Get_Integer
   HP = rBuf.Get_Byte
   MP = rBuf.Get_Byte
   aGuild = rBuf.Get_Integer
   ChatID = rBuf.Get_Byte
   CharType = rBuf.Get_Byte

</vb>