Adding Guilds
From VbGORE Visual Basic Online RPG Engine
Contents
|
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>