Sistema de Guild

por **Tayllor** Sex Ago 24, 2012 12:03 pm

Faça antes o post abaixo desse.

Faça um backup antes de adicionar o sistema, para previnir-se

******************************************************************************

SERVER

Procure por:

Código:: [b] Call SetStatus("Clearing animations...") Call ClearAnimations[/b]

Abaixo add:

Código:: [b] Call SetStatus("Clearing guilds...") Call ClearGuilds[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)[/b]

Abaixo Add:

Código:: [b] HandleDataSub(CSayGuild) = GetAddress(AddressOf HandleGuildMsg) HandleDataSub(CGuildCommand) = GetAddress(AddressOf HandleGuildCommands) HandleDataSub(CSaveGuild) = GetAddress(AddressOf HandleGuildSave)[/b]

--------------------------------------------------------------
Procure por:(Function PlayerData):

Código:: [b] Buffer.WriteLong GetPlayerX(index) Buffer.WriteLong GetPlayerY(index) Buffer.WriteLong GetPlayerDir(index) Buffer.WriteLong GetPlayerAccess(index) Buffer.WriteLong GetPlayerPK(index) For i = 1 To Stats.Stat_Count - 1 Buffer.WriteLong GetPlayerStat(index, i) Next[/b]

Abaixo Add:

Código:: [b] If Player(index).GuildFileId > 0 Then If TempPlayer(index).tmpGuildSlot > 0 Then Buffer.WriteByte 1 Buffer.WriteString GuildData(TempPlayer(index).tmpGuildSlot).Guild_Name End If Else Buffer.WriteByte 0 End If[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] ' General Name As String * ACCOUNT_LENGTH Sex As Byte Class As Long Sprite As Long Level As Byte exp As Long Access As Byte PK As Byte[/b]

Abaixo Add:

Código:: [b] GuildFileId As Long GuildMemberId As Long[/b]

-------------------------------------------------------------

Procure por:

Código:: [b]Public Type TempPlayerRec[/b]

Abaixo add

Código:: [b] tmpGuildSlot As Long tmpGuildInviteSlot As Long tmpGuildInviteTimer As Long[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] ' Checks to save players every 5 minutes - Can be tweaked If Tick > LastUpdateSavePlayers Then UpdateSavePlayers LastUpdateSavePlayers = GetTickCount 300000 End If[/b]

Abaixo Add:

Código:: [b] 'Handles Guild Invites For i = 1 To Player_HighIndex If IsPlaying(i) Then If TempPlayer(i).tmpGuildInviteSlot > 0 Then If Tick > TempPlayer(i).tmpGuildInviteTimer Then If GuildData(TempPlayer(i).tmpGuildInviteSlot).In_Use = True Then PlayerMsg i, "Time ran out to join " & GuildData(TempPlayer(i).tmpGuildInviteSlot).Guild_Name & ".", BrightRed TempPlayer(i).tmpGuildInviteSlot = 0 TempPlayer(i).tmpGuildInviteTimer = 0 Else 'Just remove this guild has been unloaded TempPlayer(i).tmpGuildInviteSlot = 0 TempPlayer(i).tmpGuildInviteTimer = 0 End If End If End If End If Next i[/b]

--------------------------------------------------------------

Procure por:(modEnumerations):

Código:: [b] SPartyInvite SPartyUpdate SPartyVitals[/b]

Abaixo add:

Código:: [b] SSendGuild SAdminGuild SGuildAdminSwitchTab[/b]

--------------------------------------------------------------

Procure por:(modEnumerations):

Código:: [b] CDeclineParty CPartyLeave[/b]

Abaixo Add:

Código:: [b] CGuildCommand CSayGuild CSaveGuild CRequestGuildAdminTabSwitch[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] ' Send welcome messages Call SendWelcome(index)[/b]

Abaixo Add

Código:: [b] 'Do all the guild start up checks Call GuildLoginCheck(index)[/b]

--------------------------------------------------------------

Procure por:(sub LeftGame):

Código:: [b] ' leave party. Party_PlayerLeave index[/b]

Abaixo Add:

Código:: [b] If Player(index).GuildFileId > 0 Then 'Set player online flag off GuildData(TempPlayer(index).tmpGuildSlot).Guild_Members(Player(index).GuildMemberId).Online = False Call CheckUnloadGuild(TempPlayer(index).tmpGuildSlot) End If[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] ' Check if the master charlist file exists for checking duplicate names, and if it doesnt make it If Not FileExist("data\accounts\charlist.txt") Then F = FreeFile Open App.Path & "\data\accounts\charlist.txt" For Output As #F Close #F End If[/b]

Abaixo Add:

Código:: [b] Call Set_Default_Guild_Ranks[/b]

---------------------------------------------------------------

Procure por:

Código:: [b] ChkDir App.Path & "\Data", "spells"[/b]

Abaixo Add:

Código:: [b] ChkDir App.Path & "\Data", "guilds"[/b]

CLIENT

Procure por:

Código:: [b]Public Sub DrawPlayerName(ByVal Index As Long) Dim TextX As Long Dim TextY As Long Dim color As Long Dim Name As String[/b]

Abaixo Add:

Código:: Dim Text2X As Long Dim Text2Y As Long Dim GuildString As String

--------------------------------------------------------------

Procure por:

Código:: [b] Name = Trim$(Player(Index).Name) ' calc pos TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) Player(Index).XOffset (PIC_X \ 2) - getWidth(TexthDC, (Trim$(Name)))[/b]

Abaixo Add:

Código:: [b] GuildString = Player(Index).GuildName Text2X = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - getWidth(TexthDC, (Trim$(GuildString)))[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - 16 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset Else ' Determine location for text TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 4 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 4 End If[/b]

Substitua por:

Código:: [b] If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset - 16 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset Else ' Determine location for text TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) 16 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) 4 End If[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] ' Draw name Call DrawText(TexthDC, TextX, TextY, Name, color)[/b]

Abaixo Add:

Código:: [b] If Not Player(Index).GuildName = vbNullString Then Call DrawText(TexthDC, Text2X, Text2Y, GuildString, color) End If[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] ' Vitals Vital(1 To Vitals.Vital_Count - 1) As Long MaxVital(1 To Vitals.Vital_Count - 1) As Long ' Stats Stat(1 To Stats.Stat_Count - 1) As Byte POINTS As Long ' Worn equipment Equipment(1 To Equipment.Equipment_Count - 1) As Long ' Position Map As Long x As Byte y As Byte Dir As Byte ' Client use only XOffset As Integer YOffset As Integer Moving As Byte Attacking As Byte AttackTimer As Long MapGetTimer As Long Step As Byte[/b]

Abaixo Add:

Código:: [b] GuildName As String [/b]

--------------------------------------------------------------

Procure por:(modEnumerations):

Código:: [b] STradeRequest SPartyInvite SPartyUpdate SPartyVitals[/b]

Abaixo Add:

Código:: [b] SSendGuild SAdminGuild SGuildAdminSwitchTab[/b]

--------------------------------------------------------------

Procure por:(modEnumerations):

Código:: [b] CPartyRequest CAcceptParty CDeclineParty CPartyLeave[/b]

Abaixo Add:

Código:: [b] CGuildCommand CSayGuild CSaveGuild CRequestGuildAdminTabSwitch[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] HandleDataSub(SPartyUpdate) = GetAddress(AddressOf HandlePartyUpdate) HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)[/b]

Abaixo Add:

Código:: [b] HandleDataSub(SSendGuild) = GetAddress(AddressOf HandleSendGuild) HandleDataSub(SAdminGuild) = GetAddress(AddressOf HandleAdminGuild) [/b]

--------------------------------------------------------------

Procure por:

Código:: [b] Call SetPlayerDir(i, Buffer.ReadLong) Call SetPlayerAccess(i, Buffer.ReadLong) Call SetPlayerPK(i, Buffer.ReadLong) For x = 1 To Stats.Stat_Count - 1 SetPlayerStat i, x, Buffer.ReadLong Next[/b]

Abaixo Add:

Código:: [b] If Buffer.ReadByte = 1 Then Player(i).GuildName = Buffer.ReadString Else Player(i).GuildName = vbNullString End If[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] If LenB(ChatText) = 0 Then Exit Sub MyText = LCase$(ChatText) ' Handle when the player presses the return key If KeyAscii = vbKeyReturn Then[/b]

Abaixo Add:

Código:: [b] 'Guild Message If Left$(ChatText, 1) = ";" Then ChatText = Mid$(ChatText, 2, Len(ChatText) - 1) If Len(ChatText) > 0 Then Call GuildMsg(ChatText) End If MyText = vbNullString frmMain.txtMyChat.text = vbNullString Exit Sub End If[/b]

--------------------------------------------------------------

Procure por:

Código:: [b] Case "/help" Call AddText("Social Commands:", HelpColor) Call AddText("'msghere = Broadcast Message", HelpColor) Call AddText("-msghere = Emote Message", HelpColor) Call AddText("!namehere msghere = Player Message", HelpColor) Call AddText("Available Commands: /info, /who, /fps, /fpslock", HelpColor) [/b]

Abaixo Add:

Código:: [b] Case "/guild" If UBound(Command) < 1 Then Call AddText("Guild Commands:", HelpColor) Call AddText("Make Guild: /guild make (GuildName)", HelpColor) Call AddText("To transfer founder status use /guild founder (name)", HelpColor) Call AddText("Invite to Guild: /guild invite (name)", HelpColor) Call AddText("Leave Guild: /guild leave", HelpColor) Call AddText("Open Guild Admin: /guild admin", HelpColor) Call AddText("Guild kick: /guild kick (name)", HelpColor) Call AddText("Guild disband: /guild disband yes", HelpColor) Call AddText("View Guild: /guild view (online/all/offline)", HelpColor) Call AddText("^Default is online, example: /guild view would display all online users.", HelpColor) Call AddText("You can talk in guild chat with: ;Message ", HelpColor) GoTo Continue End If[/b] [b]Select Case Command(1) Case "make" If UBound(Command) = 2 Then Call GuildCommand(1, Command(2)) Else Call AddText("Must have a name, use format /guild make (name)", BrightRed) End If Case "invite" If UBound(Command) = 2 Then Call GuildCommand(2, Command(2)) Else Call AddText("Must select user, use format /guild invite (name)", BrightRed) End If Case "leave" Call GuildCommand(3, "") Case "admin" Call GuildCommand(4, "") Case "view" If UBound(Command) = 2 Then Call GuildCommand(5, Command(2)) Else Call GuildCommand(5, "") End If Case "accept" Call GuildCommand(6, "") Case "decline" Call GuildCommand(7, "") Case "founder" If UBound(Command) = 2 Then Call GuildCommand(8, Command(2)) Else Call AddText("Must select user, use format /guild founder (name)", BrightRed) End If Case "kick" If UBound(Command) = 2 Then Call GuildCommand(9, Command(2)) Else Call AddText("Must select user, use format /guild kick (name)", BrightRed) End If Case "disband" If UBound(Command) = 2 Then If LCase(Command(2)) = LCase("yes") Then Call GuildCommand(10, "") Else Call AddText("Type like /guild disband yes (This is to help prevent an accident!)", BrightRed) End If Else Call AddText("Type like /guild disband yes (This is to help prevent an accident!)", BrightRed) End If End Select[/b]

Delete as contas após instalar o sistema.

Créditos:
- Scott por fazer
- Tayllor por postar e fazer uma edição das modules podendo as disponibilizar para os membros

Atenção: o tutorial em si podem postar mas não podem postar a parte que foi editada.

por **Tayllor** Qua Ago 29, 2012 1:08 pm

Atualizando:
Server
Abra-o e clique com o botão direito em module va em add e adicione um module.
- ponha o nome da module de modGuild
- Dentro da mod substitua o que tiver na mesma por:

Código:: 'For Clear functions Private Declare Sub ZeroMemory Lib "Kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long) 'Max Members Per Guild Public Const MAX_GUILD_MEMBERS As Long = 50 'Max Ranks Guilds Can Have Public Const MAX_GUILD_RANKS As Long = 6 'Max Different Permissions Public Const MAX_GUILD_RANKS_PERMISSION As Long = 6 'Max guild save files(aka max guilds) Public Const MAX_GUILD_SAVES As Long = 200 'Default Ranks Info '1: Open Admin '2: Can Recruit '3: Can Kick '4: Can Edit Ranks '5: Can Edit Users '6: Can Edit Options Public Guild_Ranks_Premission_Names(1 To MAX_GUILD_RANKS_PERMISSION) As String Public Default_Ranks(1 To MAX_GUILD_RANKS_PERMISSION) As Byte 'Max is set to MAX_PLAYERS so each online player can have his own guild Public GuildData(1 To MAX_PLAYERS) As GuildRec Public Type GuildRanksRec 'General variables Used As Boolean Name As String 'Rank Variables RankPermission(1 To MAX_GUILD_RANKS_PERMISSION) As Byte End Type Public Type GuildMemberRec 'User login/name Used As Boolean User_Login As String User_Name As String Founder As Boolean Online As Boolean 'Guild Variables Rank As Integer Comment As String * 100 End Type Public Type GuildRec In_Use As Boolean Guild_Name As String 'Guild file number for saving Guild_Fileid As Long Guild_Members(1 To MAX_GUILD_MEMBERS) As GuildMemberRec Guild_Ranks(1 To MAX_GUILD_RANKS) As GuildRanksRec 'Message of the day Guild_MOTD As String * 100 'The rank recruits start at Guild_RecruitRank As Integer 'Color of guild name Guild_Color As Integer End Type Public Sub Set_Default_Guild_Ranks() 'Max sure this starts at 1 and ends at MAX_GUILD_RANKS_PERMISSION (Default 7) '0 = Cannot, 1 = Able To Guild_Ranks_Premission_Names(1) = "Open Admin" Default_Ranks(1) = 0 Guild_Ranks_Premission_Names(2) = "Can Recruit" Default_Ranks(2) = 1 Guild_Ranks_Premission_Names(3) = "Can Kick" Default_Ranks(3) = 0 Guild_Ranks_Premission_Names(4) = "Can Edit Ranks" Default_Ranks(4) = 0 Guild_Ranks_Premission_Names(5) = "Can Edit Users" Default_Ranks(5) = 0 Guild_Ranks_Premission_Names(6) = "Can Edit Options" Default_Ranks(6) = 0 End Sub Public Function GuildCheckName(Index As Long, MemberSlot As Long, AttemptCorrect As Boolean) As Boolean Dim i As Integer If Player(Index).GuildFileId = 0 Or TempPlayer(Index).tmpGuildSlot = 0 Or IsPlaying(Index) = False Or MemberSlot = 0 Then GuildCheckName = False Exit Function End If If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(MemberSlot).User_Login = Player(Index).Login Then GuildCheckName = True Exit Function End If If AttemptCorrect = True Then If TempPlayer(Index).tmpGuildSlot > 0 And Player(Index).GuildFileId > 0 Then 'did they get moved? For i = 1 To MAX_GUILD_MEMBERS If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).User_Login = Player(Index).Login Then Player(Index).GuildMemberId = i Call SavePlayer(Index) GuildCheckName = True Exit Function Else Player(Index).GuildMemberId = 0 End If Next i 'Remove from guild if we can't find them If Player(Index).GuildMemberId = 0 Then Player(Index).GuildFileId = 0 TempPlayer(Index).tmpGuildSlot = 0 Call SavePlayer(Index) PlayerMsg Index, "We can't seem to find you on your guilds member list this could mean a couple things.", BrightRed PlayerMsg Index, "1)They kicked you out 2)Your guild was deleted and replaced by another", BrightRed End If End If End If GuildCheckName = False End Function Public Sub MakeGuild(Founder_Index As Long, Name As String) Dim tmpGuild As GuildRec Dim GuildSlot As Long Dim GuildFileId As Long Dim i As Integer Dim b As Integer If Player(Founder_Index).GuildFileId > 0 Then PlayerMsg Founder_Index, "You must leave your current guild before you make this one!", BrightRed Exit Sub End If GuildFileId = Find_Guild_Save GuildSlot = FindOpenGuildSlot If Not IsPlaying(Founder_Index) Then Exit Sub 'We are unable for an unknown reason If GuildSlot = 0 Or GuildFileId = 0 Then PlayerMsg Founder_Index, "Unable to make guild, sorry!", BrightRed Exit Sub End If If Name = "" Then PlayerMsg Founder_Index, "Your guild needs a name!", BrightRed Exit Sub End If GuildData(GuildSlot).Guild_Name = Name GuildData(GuildSlot).In_Use = True GuildData(GuildSlot).Guild_Fileid = GuildFileId GuildData(GuildSlot).Guild_Members(1).Founder = True GuildData(GuildSlot).Guild_Members(1).User_Login = Player(Founder_Index).Login GuildData(GuildSlot).Guild_Members(1).User_Name = Player(Founder_Index).Name GuildData(GuildSlot).Guild_Members(1).Rank = MAX_GUILD_RANKS GuildData(GuildSlot).Guild_Members(1).Comment = "Guild Founder" GuildData(GuildSlot).Guild_Members(1).Used = True GuildData(GuildSlot).Guild_Members(1).Online = True 'Set up Admin Rank with all permission which is just the max rank GuildData(GuildSlot).Guild_Ranks(MAX_GUILD_RANKS).Name = "Leader" GuildData(GuildSlot).Guild_Ranks(MAX_GUILD_RANKS).Used = True For b = 1 To MAX_GUILD_RANKS_PERMISSION GuildData(GuildSlot).Guild_Ranks(MAX_GUILD_RANKS).RankPermission(b) = 1 Next b 'Set up rest of the ranks with default permission For i = 1 To MAX_GUILD_RANKS - 1 GuildData(GuildSlot).Guild_Ranks(i).Name = "Rank " & i GuildData(GuildSlot).Guild_Ranks(i).Used = True For b = 1 To MAX_GUILD_RANKS_PERMISSION GuildData(GuildSlot).Guild_Ranks(i).RankPermission(b) = Default_Ranks(b) Next b Next i Player(Founder_Index).GuildFileId = GuildFileId Player(Founder_Index).GuildMemberId = 1 TempPlayer(Founder_Index).tmpGuildSlot = GuildSlot 'Save Call SaveGuild(GuildSlot) Call SavePlayer(Founder_Index) 'Send to player Call SendGuild(False, Founder_Index, GuildSlot) 'Inform users PlayerMsg Founder_Index, "Guild Successfully Created!", BrightGreen PlayerMsg Founder_Index, "Welcome to " & GuildData(GuildSlot).Guild_Name & ".", BrightGreen PlayerMsg Index, "You can talk in guild chat with: ;Message ", BrightRed 'Update user for guild name display Call SendPlayerData(Founder_Index) End Sub Public Function CheckGuildPermission(Index As Long, Permission As Integer) As Boolean Dim GuildSlot As Long 'Get slot GuildSlot = TempPlayer(Index).tmpGuildSlot 'Make sure we are talking about the same person If Not GuildData(GuildSlot).Guild_Members(Player(Index).GuildMemberId).User_Login = Player(Index).Login Then 'Something went wrong and they are not allowed to do anything CheckGuildPermission = False Exit Function End If 'If founder, true in every case If GuildData(GuildSlot).Guild_Members(Player(Index).GuildMemberId).Founder = True Then CheckGuildPermission = True Exit Function End If 'Make sure this slot is being used aka they are still a member If GuildData(GuildSlot).Guild_Members(Player(Index).GuildMemberId).Used = False Then 'Something went wrong and they are not allowed to do anything CheckGuildPermission = False Exit Function End If 'Check if they are able to If GuildData(GuildSlot).Guild_Ranks(GuildData(GuildSlot).Guild_Members(Player(Index).GuildMemberId).Rank).RankPermission(Permission) = 1 Then CheckGuildPermission = True Else CheckGuildPermission = False End If End Function Public Sub Request_Guild_Invite(Index As Long, GuildSlot As Long, Inviter_Index As Long) If Player(Index).GuildFileId > 0 Then PlayerMsg Index, "You must leave your current guild before you can join " & GuildData(GuildSlot).Guild_Name & "!", BrightRed PlayerMsg Inviter_Index, "They are unable to join because they are already in a guild!", BrightRed Exit Sub End If If TempPlayer(Index).tmpGuildInviteSlot > 0 Then PlayerMsg Inviter_Index, "This user has a pending invite try again.", BrightRed Exit Sub End If 'Permission 2 = Can Recruit If CheckGuildPermission(Inviter_Index, 2) = False Then PlayerMsg Inviter_Index, "Sorry your rank is not high enough!", BrightRed Exit Sub End If TempPlayer(Index).tmpGuildInviteSlot = GuildSlot '2 minute TempPlayer(Index).tmpGuildInviteTimer = GetTickCount + 120000 TempPlayer(Index).tmpGuildInviteId = Player(Inviter_Index).GuildFileId PlayerMsg Inviter_Index, "Guild invite sent!", Green PlayerMsg Index, Player(Inviter_Index).Name & " has invited you to join the guild " & GuildData(GuildSlot).Guild_Name & "!", Green PlayerMsg Index, "Type /guild accept within the next 2 Minutes to join.", Green PlayerMsg Index, "Type /guild decline to remove the offer.", Green End Sub Public Sub Join_Guild(Index As Long, GuildSlot As Long) Dim OpenSlot As Long If IsPlaying(Index) = False Then Exit Sub OpenSlot = FindOpenGuildMemberSlot(GuildSlot) 'Guild full? If OpenSlot > 0 Then 'Set guild data GuildData(GuildSlot).Guild_Members(OpenSlot).Used = True GuildData(GuildSlot).Guild_Members(OpenSlot).User_Login = Player(Index).Login GuildData(GuildSlot).Guild_Members(OpenSlot).User_Name = Player(Index).Name GuildData(GuildSlot).Guild_Members(OpenSlot).Rank = GuildData(GuildSlot).Guild_RecruitRank GuildData(GuildSlot).Guild_Members(OpenSlot).Comment = "Joined: " & DateValue(Now) GuildData(GuildSlot).Guild_Members(OpenSlot).Online = True 'Set player data Player(Index).GuildFileId = GuildData(GuildSlot).Guild_Fileid Player(Index).GuildMemberId = OpenSlot TempPlayer(Index).tmpGuildSlot = GuildSlot 'Save Call SaveGuild(GuildSlot) Call SavePlayer(Index) 'Send player guild data and display welcome Call SendGuild(False, Index, GuildSlot) PlayerMsg Index, "Welcome to " & GuildData(GuildSlot).Guild_Name & ".", BrightGreen PlayerMsg Index, "You can talk in guild chat with: ;Message", BrightGreen 'Update player to display guild name Call SendPlayerData(Index) Else 'Guild full display msg PlayerMsg Index, "Guild is full sorry!", BrightRed End If End Sub Public Function Find_Guild_Save() As Long Dim FoundSlot As Boolean Dim Current As Integer FoundSlot = False Current = 1 Do Until FoundSlot = True If Not FileExist("\Data\guilds\Guild" & Current & ".dat") Then Find_Guild_Save = Current FoundSlot = True Else Current = Current + 1 End If 'Max Guild Files check If Current > MAX_GUILD_SAVES Then 'send back 0 for no slot found Find_Guild_Save = 0 FoundSlot = True End If Loop End Function Public Function FindOpenGuildSlot() As Long Dim i As Integer For i = 1 To MAX_PLAYERS If GuildData(i).In_Use = False Then FindOpenGuildSlot = i Exit Function End If 'No slot found how? FindOpenGuildSlot = 0 Next i End Function Public Function FindOpenGuildMemberSlot(GuildSlot As Long) As Long Dim i As Integer For i = 1 To MAX_GUILD_MEMBERS If GuildData(GuildSlot).Guild_Members(i).Used = False Then FindOpenGuildMemberSlot = i Exit Function End If Next i 'Guild is full sorry bub FindOpenGuildMemberSlot = 0 End Function Public Sub ClearGuildMemberSlot(GuildSlot As Long, MembersSlot As Long) GuildData(GuildSlot).Guild_Members(MembersSlot).Used = False GuildData(GuildSlot).Guild_Members(MembersSlot).User_Login = vbNullString GuildData(GuildSlot).Guild_Members(MembersSlot).User_Name = vbNullString GuildData(GuildSlot).Guild_Members(MembersSlot).Rank = 0 GuildData(GuildSlot).Guild_Members(MembersSlot).Comment = vbNullString GuildData(GuildSlot).Guild_Members(MembersSlot).Founder = False GuildData(GuildSlot).Guild_Members(MembersSlot).Online = False 'Save guild after we remove member Call SaveGuild(GuildSlot) End Sub Public Sub LoadGuild(GuildSlot As Long, GuildFileId As Long) Dim i As Integer 'If 0 something is wrong If GuildFileId = 0 Then Exit Sub 'Does this file even exist? If Not FileExist("\Data\guilds\Guild" & GuildFileId & ".dat") Then Exit Sub Dim filename As String Dim F As Long filename = App.Path & "\data\guilds\Guild" & GuildFileId & ".dat" F = FreeFile Open filename For Binary As #F Get #F, , GuildData(GuildSlot) Close #F GuildData(GuildSlot).In_Use = True 'Make sure an online flag didn't manage to slip through For i = 1 To MAX_GUILD_MEMBERS If GuildData(GuildSlot).Guild_Members(i).Online = True Then GuildData(GuildSlot).Guild_Members(i).Online = False End If Next i End Sub Public Sub SaveGuild(GuildSlot As Long) 'Dont save unless a fileid was assigned If GuildData(GuildSlot).Guild_Fileid = 0 Then Exit Sub Dim filename As String Dim F As Long filename = App.Path & "\data\guilds\Guild" & GuildData(GuildSlot).Guild_Fileid & ".dat" F = FreeFile Open filename For Binary As #F Put #F, , GuildData(GuildSlot) Close #F End Sub Public Sub UnloadGuildSlot(GuildSlot As Long) 'Exit on error If GuildSlot = 0 Or GuildSlot > MAX_GUILD_SAVES Then Exit Sub If GuildData(GuildSlot).In_Use = False Then Exit Sub 'Save it first Call SaveGuild(GuildSlot) 'Clear and reset for next use Call ClearGuild(GuildSlot) End Sub Public Sub ClearGuilds() Dim i As Long For i = 1 To MAX_PLAYERS Call ClearGuild(i) Next i End Sub Public Sub ClearGuild(Index As Long) Call ZeroMemory(ByVal VarPtr(GuildData(Index)), LenB(GuildData(Index))) GuildData(Index).Guild_Name = vbNullString GuildData(Index).In_Use = False GuildData(Index).Guild_Fileid = 0 GuildData(Index).Guild_Color = 1 GuildData(Index).Guild_RecruitRank = 1 End Sub Public Sub CheckUnloadGuild(GuildSlot As Long) Dim i As Integer Dim UnloadGuild As Boolean UnloadGuild = True If GuildData(GuildSlot).In_Use = False Then Exit Sub For i = 1 To Player_HighIndex If IsPlaying(i) Then If Player(i).GuildFileId = GuildData(GuildSlot).Guild_Fileid Then UnloadGuild = False Exit For End If End If Next i If UnloadGuild = True Then Call UnloadGuildSlot(GuildSlot) End If End Sub Public Sub GuildKick(GuildSlot As Long, Index As Long, playerName As String) Dim FoundOffline As Boolean Dim IsOnline As Boolean Dim OnlineIndex As Long Dim MemberSlot As Long Dim i As Integer OnlineIndex = FindPlayer(playerName) If OnlineIndex = Index Then PlayerMsg Index, "Can't kick your self!", BrightRed Exit Sub End If 'If OnlineIndex > 0 they are online If OnlineIndex > 0 Then IsOnline = True If Player(OnlineIndex).GuildMemberId > 0 Then MemberSlot = Player(OnlineIndex).GuildMemberId Else 'Prevent error, rest of this code assumes this is greater than 0 Exit Sub End If Else IsOnline = False End If 'Handle kicking online user If IsOnline = True Then If Not Player(Index).GuildFileId = Player(OnlineIndex).GuildFileId Then PlayerMsg Index, "User must be in your guild to kick them!", BrightRed Exit Sub End If If GuildData(GuildSlot).Guild_Members(MemberSlot).Founder = True Then PlayerMsg Index, "You cannot kick your founder!!", BrightRed Exit Sub End If Player(OnlineIndex).GuildFileId = 0 Player(OnlineIndex).GuildMemberId = 0 TempPlayer(OnlineIndex).tmpGuildSlot = 0 Call ClearGuildMemberSlot(GuildSlot, MemberSlot) PlayerMsg OnlineIndex, "You have been kicked from your guild!", BrightRed PlayerMsg Index, "Player kicked!", BrightRed Call SavePlayer(OnlineIndex) Call SaveGuild(GuildSlot) Call SendPlayerData(OnlineIndex) Exit Sub End If 'Handle Kicking Offline User FoundOffline = False If IsOnline = False Then 'Lets Try to find them in the roster For i = 1 To MAX_GUILD_MEMBERS If playerName = Trim$(GuildData(GuildSlot).Guild_Members(i).User_Name) Then 'Found them FoundOffline = True MemberSlot = i Exit For End If Next i If FoundOffline = True Then If MemberSlot = 0 Then Exit Sub Call ClearGuildMemberSlot(GuildSlot, MemberSlot) Call SaveGuild(GuildSlot) PlayerMsg Index, "Offline user kicked!", BrightRed Exit Sub End If If FoundOffline = False And IsOnline = False Then PlayerMsg Index, "Could not find " & playerName & " online or offline in your guild.", BrightRed End If End If End Sub Public Sub GuildLeave(Index As Long) Dim i As Integer 'This is for the leave command only, kicking has its own sub because it handles both online and offline kicks, while this only handles online. If Not Player(Index).GuildFileId > 0 Then PlayerMsg Index, "You must be in a guild to leave one!", BrightRed Exit Sub End If If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(Player(Index).GuildMemberId).Founder = True Then PlayerMsg Index, "The founder cannot leave or be kicked, founder status must first be transfered.", BrightRed PlayerMsg Index, "Use command /founder (name) to transfer this.", BrightRed Exit Sub End If 'They match so they can leave If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(Player(Index).GuildMemberId).User_Login = Player(Index).Login Then 'Clear guild slot Call ClearGuildMemberSlot(TempPlayer(Index).tmpGuildSlot, Player(Index).GuildMemberId) 'Clear player data Player(Index).GuildFileId = 0 Player(Index).GuildMemberId = 0 TempPlayer(Index).tmpGuildSlot = 0 'Update user for guild name display Call SendPlayerData(Index) PlayerMsg Index, "You have left the guild.", BrightRed Else 'They don't match this slot remove them Player(Index).GuildFileId = 0 Player(Index).GuildMemberId = 0 TempPlayer(Index).tmpGuildSlot = 0 End If End Sub Public Sub GuildLoginCheck(Index As Long) Dim i As Long Dim GuildSlot As Long Dim GuildLoaded As Boolean GuildLoaded = False 'Not in guild If Player(Index).GuildFileId = 0 Then Exit Sub 'Check to make sure the guild file exists If Not FileExist("\Data\guilds\Guild" & Player(Index).GuildFileId & ".dat") Then 'If guild was deleted remove user from guild Player(Index).GuildFileId = 0 Player(Index).GuildMemberId = 0 TempPlayer(Index).tmpGuildSlot = 0 Call SavePlayer(Index) PlayerMsg Index, "Your guild has been deleted sorry!", BrightRed Exit Sub End If 'First we need to see if our guild is loaded For i = 1 To MAX_PLAYERS If GuildData(i).In_Use = True Then 'If its already loaded set true If GuildData(i).Guild_Fileid = Player(Index).GuildFileId Then GuildLoaded = True GuildSlot = i Exit For End If End If Next i 'If the guild is not loaded we need to load it If GuildLoaded = False Then 'Find open guild slot, if 0 none GuildSlot = FindOpenGuildSlot If GuildSlot > 0 Then 'LoadGuild Call LoadGuild(GuildSlot, Player(Index).GuildFileId) End If End If 'Set GuildSlot TempPlayer(Index).tmpGuildSlot = GuildSlot 'This is to prevent errors when we look for them If Player(Index).GuildMemberId = 0 Then Player(Index).GuildMemberId = 1 'Make sure user didn't get kicked or guild was replaced by a different guild, both result in removal If GuildCheckName(Index, Player(Index).GuildMemberId, True) = False Then 'unload if this user is not in this guild and it was loaded for this user If GuildLoaded = False Then Call UnloadGuildSlot(GuildSlot) Exit Sub End If End If 'Sent data and set slot if all is good If Player(Index).GuildFileId > 0 Then 'Set online flag GuildData(GuildSlot).Guild_Members(Player(Index).GuildMemberId).Online = True 'send Call SendGuild(False, Index, GuildSlot) 'Display motd If Not GuildData(GuildSlot).Guild_MOTD = vbNullString Then PlayerMsg Index, "Guild Motd: " & GuildData(GuildSlot).Guild_MOTD, Blue End If End If End Sub Sub DisbandGuild(GuildSlot As Long, Index As Long) Dim i As Integer Dim tmpGuildSlot As Long Dim TmpGuildFileId As Long Dim filename As String 'Set some thing we need tmpGuildSlot = GuildSlot TmpGuildFileId = GuildData(tmpGuildSlot).Guild_Fileid 'They are who they say they are, and are founder If GuildCheckName(Index, Player(Index).GuildMemberId, False) = True And GuildData(tmpGuildSlot).Guild_Members(Player(Index).GuildMemberId).Founder = True Then 'File exists right? If FileExist("\Data\Guilds\Guild" & TmpGuildFileId & ".dat") = True Then 'We have a go for disband 'First we take everyone online out, this will include the founder people who login later will be kicked out then For i = 1 To Player_HighIndex If IsPlaying(i) = True Then If Player(i).GuildFileId = TmpGuildFileId Then 'remove from guild Player(i).GuildFileId = 0 Player(i).GuildMemberId = 0 TempPlayer(i).tmpGuildSlot = 0 Call SavePlayer(i) 'Send player data so they don't have name over head anymore Call SendPlayerData(i) End If End If Next i 'Unload Guild from memory Call UnloadGuildSlot(tmpGuildSlot) filename = App.Path & "\Data\Guilds\Guild" & TmpGuildFileId & ".dat" Kill filename PlayerMsg Index, "Guild disband done!", BrightGreen End If Else PlayerMsg Index, "Your not allowed to do that!", BrightRed End If End Sub Sub SendDataToGuild(ByVal GuildSlot As Long, ByRef Data() As Byte) Dim i As Long For i = 1 To Player_HighIndex If IsPlaying(i) Then If Player(i).GuildFileId = GuildData(GuildSlot).Guild_Fileid Then Call SendDataTo(i, Data) End If End If Next End Sub Sub SendGuild(ByVal SendToWholeGuild As Boolean, ByVal Index As Long, ByVal GuildSlot) Dim Buffer As clsBuffer Dim i As Integer Dim b As Integer Set Buffer = New clsBuffer Buffer.WriteLong SSendGuild 'General data Buffer.WriteString GuildData(GuildSlot).Guild_Name Buffer.WriteInteger GuildData(GuildSlot).Guild_Color Buffer.WriteString GuildData(GuildSlot).Guild_MOTD Buffer.WriteInteger GuildData(GuildSlot).Guild_RecruitRank 'Send Members For i = 1 To MAX_GUILD_MEMBERS Buffer.WriteString GuildData(GuildSlot).Guild_Members(i).User_Name Buffer.WriteInteger GuildData(GuildSlot).Guild_Members(i).Rank Buffer.WriteString GuildData(GuildSlot).Guild_Members(i).Comment Next i 'Send Ranks For i = 1 To MAX_GUILD_RANKS Buffer.WriteString GuildData(GuildSlot).Guild_Ranks(i).Name For b = 1 To MAX_GUILD_RANKS_PERMISSION Buffer.WriteByte GuildData(GuildSlot).Guild_Ranks(i).RankPermission(b) Buffer.WriteString Guild_Ranks_Premission_Names(b) Next b Next i If SendToWholeGuild = False Then SendDataTo Index, Buffer.ToArray() Else SendDataToGuild GuildSlot, Buffer.ToArray() End If Set Buffer = Nothing End Sub Sub ToggleGuildAdmin(ByVal Index As Long, ByVal GuildSlot, ByVal OpenAdmin As Boolean) Dim Buffer As clsBuffer Dim i As Integer Dim b As Integer Set Buffer = New clsBuffer Buffer.WriteLong SAdminGuild If OpenAdmin = True Then Buffer.WriteByte 1 Else Buffer.WriteByte 0 End If SendDataTo Index, Buffer.ToArray() Set Buffer = Nothing End Sub Sub SayMsg_Guild(ByVal GuildSlot As Long, ByVal Index As Long, ByVal message As String, ByVal saycolour As Long) Dim Buffer As clsBuffer Set Buffer = New clsBuffer Buffer.WriteLong SSayMsg Buffer.WriteString GetPlayerName(Index) Buffer.WriteLong GetPlayerAccess(Index) Buffer.WriteLong GetPlayerPK(Index) Buffer.WriteString message Buffer.WriteString "[" & GuildData(GuildSlot).Guild_Name & "]" Buffer.WriteLong saycolour SendDataToGuild GuildSlot, Buffer.ToArray() Set Buffer = Nothing End Sub Public Sub HandleGuildMsg(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim Msg As String Dim s As String Dim i As Long Dim Buffer As clsBuffer Set Buffer = New clsBuffer Buffer.WriteBytes Data() Msg = Buffer.ReadString ' Prevent hacking For i = 1 To Len(Msg) If AscW(Mid$(Msg, i, 1)) < 32 Or AscW(Mid$(Msg, i, 1)) > 126 Then Exit Sub End If Next If Not Player(Index).GuildFileId > 0 Then PlayerMsg Index, "You need to be in a guild to talk in Guild Chat!", BrightRed Exit Sub End If s = "[" & GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Name & "]" & GetPlayerName(Index) & ": " & Msg Call SayMsg_Guild(TempPlayer(Index).tmpGuildSlot, Index, Msg, QBColor(White)) Call AddLog(s, PLAYER_LOG) Call TextAdd(Msg) Set Buffer = Nothing End Sub Public Sub HandleGuildSave(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim Buffer As clsBuffer Dim SaveType As Integer Dim SentIndex As Integer Dim HoldInt As Integer Dim i As Integer Set Buffer = New clsBuffer Buffer.WriteBytes Data() SaveType = Buffer.ReadInteger SentIndex = Buffer.ReadInteger If SaveType = 0 Or SentIndex = 0 Then Exit Sub Select Case SaveType Case 1 'options If CheckGuildPermission(Index, 6) = True Then 'Guild Color HoldInt = Buffer.ReadInteger If HoldInt > 0 Then GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Color = HoldInt HoldInt = 0 End If 'Guild Recruit rank HoldInt = Buffer.ReadInteger 'Guild MOTD GuildData(TempPlayer(Index).tmpGuildSlot).Guild_MOTD = Buffer.ReadString 'Did Recruit Rank change? Make sure they didnt set recruit rank at or above their rank If Not GuildData(TempPlayer(Index).tmpGuildSlot).Guild_RecruitRank = HoldInt Then If Not HoldInt >= GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(Player(Index).GuildMemberId).Rank Then GuildData(TempPlayer(Index).tmpGuildSlot).Guild_RecruitRank = HoldInt Else PlayerMsg Index, "You may not set the recruit rank higher or at your rank.", BrightRed End If End If Else PlayerMsg Index, "You are not allowed to save options.", BrightRed End If HoldInt = 0 Case 2 'users If CheckGuildPermission(Index, 5) = True Then 'Guild Member Rank HoldInt = Buffer.ReadInteger If HoldInt > 0 Then GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(SentIndex).Rank = HoldInt Else PlayerMsg Index, "Must set rank above 0", BrightRed End If 'Guild Member Comment GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(SentIndex).Comment = Buffer.ReadString Else PlayerMsg Index, "You are not allowed to save users.", BrightRed End If Case 3 'ranks If CheckGuildPermission(Index, 4) = True Then GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Ranks(SentIndex).Name = Buffer.ReadString For i = 1 To MAX_GUILD_RANKS_PERMISSION GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Ranks(SentIndex).RankPermission(i) = Buffer.ReadByte Next i Else PlayerMsg Index, "You are not allowed to save ranks.", BrightRed End If End Select Call SendGuild(True, Index, TempPlayer(Index).tmpGuildSlot) Set Buffer = Nothing End Sub Public Sub HandleGuildCommands(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim i As Integer Dim SelectedIndex As Long Dim SendText As String Dim SelectedCommand As Integer Dim MembersCount As Long Dim Buffer As clsBuffer Set Buffer = New clsBuffer Buffer.WriteBytes Data() SelectedCommand = Buffer.ReadInteger SendText = Buffer.ReadString 'Command 1/6/7 can be used while not in a guild If Player(Index).GuildFileId = 0 And Not (SelectedCommand = 1 Or SelectedCommand = 6 Or SelectedCommand = 7) Then PlayerMsg Index, "You must be in a guild to use this commands!", BrightRed Exit Sub End If Select Case SelectedCommand Case 1 'make Call MakeGuild(Index, SendText) Case 2 'invite 'Find user index SelectedIndex = 0 'Try to find player SelectedIndex = FindPlayer(SendText) If SelectedIndex > 0 Then Call Request_Guild_Invite(SelectedIndex, TempPlayer(Index).tmpGuildSlot, Index) Else PlayerMsg Index, "Could not find user " & SendText & ".", BrightRed End If Case 3 'leave Call GuildLeave(Index) Case 4 'admin If CheckGuildPermission(Index, 1) = True Then Call ToggleGuildAdmin(Index, TempPlayer(Index).tmpGuildSlot, True) Else PlayerMsg Index, "You are not allowed to open the admin panel.", BrightRed End If Case 5 'view 'This sets the default option If SendText = "" Then SendText = "online" MembersCount = 0 Select Case SendText Case "online" PlayerMsg Index, GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Name & " Members List (" & UCase(SendText) & ")", Green For i = 1 To MAX_GUILD_MEMBERS If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).Used = True Then If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).Online = True Then PlayerMsg Index, GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).User_Name, Green MembersCount = MembersCount + 1 End If End If Next i PlayerMsg Index, "Total: " & MembersCount, Green Case "all" PlayerMsg Index, GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Name & " Members List (" & UCase(SendText) & ")", Green For i = 1 To MAX_GUILD_MEMBERS If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).Used = True Then PlayerMsg Index, GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).User_Name, Green MembersCount = MembersCount + 1 End If Next i PlayerMsg Index, "Total: " & MembersCount, Green Case "offline" PlayerMsg Index, GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Name & " Members List (" & UCase(SendText) & ")", Green For i = 1 To MAX_GUILD_MEMBERS If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).Used = True Then If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).Online = False Then PlayerMsg Index, GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(i).User_Name, Green MembersCount = MembersCount + 1 End If End If Next i PlayerMsg Index, "Total: " & MembersCount, Green End Select Case 6 'accept If TempPlayer(Index).tmpGuildInviteSlot > 0 Then If GuildData(TempPlayer(Index).tmpGuildInviteSlot).In_Use = True And GuildData(TempPlayer(Index).tmpGuildInviteSlot).Guild_Fileid = TempPlayer(Index).tmpGuildInviteId Then Call Join_Guild(Index, TempPlayer(Index).tmpGuildInviteSlot) TempPlayer(Index).tmpGuildInviteSlot = 0 TempPlayer(Index).tmpGuildInviteTimer = 0 TempPlayer(Index).tmpGuildInviteId = 0 Else PlayerMsg Index, "No one from this guild is online any more, please ask for a new invite.", BrightRed End If Else PlayerMsg Index, "You must get a guild invite to use this command.", BrightRed End If Case 7 'decline If TempPlayer(Index).tmpGuildInviteSlot > 0 Then TempPlayer(Index).tmpGuildInviteSlot = 0 TempPlayer(Index).tmpGuildInviteTimer = 0 TempPlayer(Index).tmpGuildInviteId = 0 PlayerMsg Index, "You declined the guild invite.", BrightRed Else PlayerMsg Index, "You must get a guild invite to use this command.", BrightRed End If Case 8 'founder 'Make sure the person who used the command is who they say they are If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(Player(Index).GuildMemberId).User_Login = Player(Index).Login Then 'Make sure they are founder If GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(Player(Index).GuildMemberId).Founder = True Then 'Find user index SelectedIndex = 0 'Try to find player SelectedIndex = FindPlayer(SendText) If SelectedIndex > 0 Then 'Make sure the person getting founder is the correct person If GuildData(TempPlayer(SelectedIndex).tmpGuildSlot).Guild_Members(Player(SelectedIndex).GuildMemberId).User_Login = Player(SelectedIndex).Login Then GuildData(TempPlayer(Index).tmpGuildSlot).Guild_Members(Player(Index).GuildMemberId).Founder = False GuildData(TempPlayer(SelectedIndex).tmpGuildSlot).Guild_Members(Player(SelectedIndex).GuildMemberId).Founder = True End If Else PlayerMsg Index, "Could not find user " & SendText & ".", BrightRed End If Else PlayerMsg Index, "You must be marked as a founder to use this command.", BrightRed End If End If Case 9 'kick Call GuildKick(TempPlayer(Index).tmpGuildSlot, Index, SendText) Case 10 'disband Call DisbandGuild(TempPlayer(Index).tmpGuildSlot, Index) End Select Set Buffer = Nothing End Sub

Client
- Faça o mesmo processo que no Server, coloque os arquivos da guild na pasta src, e depois arraste para dentro do projeto
- Faça o mesmo processo que no Server, coloque os arquivos da guild na pasta src, e depois arraste para dentro do projeto porem invés de por o codigo que pois no server ponha esse:

Código:: Public Const MAX_GUILD_MEMBERS As Long = 50 Public Const MAX_GUILD_RANKS As Long = 6 Public Const MAX_GUILD_RANKS_PERMISSION As Long = 6 Public GuildData As GuildRec Public Type GuildRanksRec 'General variables Used As Boolean Name As String 'Rank Variables RankPermission(1 To MAX_GUILD_RANKS_PERMISSION) As Byte RankPermissionName(1 To MAX_GUILD_RANKS_PERMISSION) As String End Type Public Type GuildMemberRec 'User login/name Used As Boolean User_Login As String User_Name As String Founder As Boolean 'Guild Variables Rank As Integer Comment As String * 300 End Type Public Type GuildRec In_Use As Boolean Guild_Name As String 'Guild file number for saving Guild_Fileid As Long Guild_Members(1 To MAX_GUILD_MEMBERS) As GuildMemberRec Guild_Ranks(1 To MAX_GUILD_RANKS) As GuildRanksRec 'Message of the day Guild_MOTD As String * 100 'The rank recruits start at Guild_RecruitRank As Integer Guild_Color As Integer End Type Public Sub HandleAdminGuild(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim Buffer As clsBuffer Dim i As Integer Dim b As Integer If Options.Debug = 1 Then On Error GoTo errorhandler Set Buffer = New clsBuffer Buffer.WriteBytes Data() If Buffer.ReadByte = 1 Then frmGuildAdmin.Visible = True Else frmGuildAdmin.Visible = False End If Set Buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "HandleAdminGuild", "modGuild", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear End Sub Public Sub HandleSendGuild(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long) Dim Buffer As clsBuffer Dim i As Integer Dim b As Integer If Options.Debug = 1 Then On Error GoTo errorhandler Set Buffer = New clsBuffer Buffer.WriteBytes Data() GuildData.Guild_Name = Buffer.ReadString GuildData.Guild_Color = Buffer.ReadInteger GuildData.Guild_MOTD = Buffer.ReadString GuildData.Guild_RecruitRank = Buffer.ReadInteger 'Get Members For i = 1 To MAX_GUILD_MEMBERS GuildData.Guild_Members(i).User_Name = Buffer.ReadString GuildData.Guild_Members(i).Rank = Buffer.ReadInteger GuildData.Guild_Members(i).Comment = Buffer.ReadString Next i 'Get Ranks For i = 1 To MAX_GUILD_RANKS GuildData.Guild_Ranks(i).Name = Buffer.ReadString For b = 1 To MAX_GUILD_RANKS_PERMISSION GuildData.Guild_Ranks(i).RankPermission(b) = Buffer.ReadByte GuildData.Guild_Ranks(i).RankPermissionName(b) = Buffer.ReadString Next b Next i 'Update Guildadmin data Call frmGuildAdmin.Load_Guild_Admin Set Buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "HandleSendGuild", "modGuild", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear End Sub Public Sub GuildMsg(ByVal text As String) Dim Buffer As clsBuffer ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Set Buffer = New clsBuffer Buffer.WriteLong CSayGuild Buffer.WriteString text SendData Buffer.ToArray() Set Buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "GuildMsg", "modGuild", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Sub GuildCommand(ByVal Command As Integer, ByVal SendText As String) Dim Buffer As clsBuffer ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Set Buffer = New clsBuffer Buffer.WriteLong CGuildCommand Buffer.WriteInteger Command Buffer.WriteString SendText SendData Buffer.ToArray() Set Buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "GuildMsg", "modGuild", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Sub GuildSave(ByVal SaveType As Integer, ByVal Index As Integer) Dim Buffer As clsBuffer Dim i As Integer Dim b As Integer 'SaveType '1=options '2=users '3=ranks If Index = 0 Then Exit Sub ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Set Buffer = New clsBuffer Buffer.WriteLong CSaveGuild Buffer.WriteInteger SaveType Buffer.WriteInteger Index Select Case SaveType Case 1 'options Buffer.WriteInteger GuildData.Guild_Color Buffer.WriteInteger GuildData.Guild_RecruitRank Buffer.WriteString GuildData.Guild_MOTD Case 2 'users Buffer.WriteInteger GuildData.Guild_Members(Index).Rank Buffer.WriteString GuildData.Guild_Members(Index).Comment Case 3 'ranks Buffer.WriteString GuildData.Guild_Ranks(Index).Name For i = 1 To MAX_GUILD_RANKS_PERMISSION Buffer.WriteByte GuildData.Guild_Ranks(Index).RankPermission(i) Next i End Select SendData Buffer.ToArray() Set Buffer = Nothing ' Error handler Exit Sub errorhandler: HandleError "GuildMsg", "modGuild", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub

- por final baixe esse arquivo [Tens de ter uma conta e sessão iniciada para poderes visualizar este link] e ponha na pasta src garantido que tenha arrastado para o projeto.(é o painel de admin)

Agora faça o sistema acima.

por **~FullzDied** Qua Ago 29, 2012 4:45 pm

Cara bota em code pra ficar mais organizado

Código:: [code][/code]

por **Tayllor** Qua Ago 29, 2012 6:10 pm

Vou por assim que der, tava ocupado.

por Alumary Dom Set 02, 2012 12:31 am

acusa na hora de compilar esse grupo de palavras ai fis tudo sertin! .tmpGuildInviteId

editando, acusa uma linha vermlhando completa nisso aqi

GuildString = Player(Index).GuildName
Text2X = ConvertMapX(GetPlayerX(Index) * PIC_X) Player(Index).XOffset (PIC_X \ 2) - getWidth(TexthDC, (Trim$(GuildString)))

por **Tayllor** Dom Set 02, 2012 7:47 am

Alumary substitua essa linha ai que deu o erro por essa:

Código:: Text2X = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - getWidth(TexthDC, (Trim$(GuildString)))

tava faltando + ^^.

@Edit
Substitua essa que eu mandei substituir no tutorial:

Código:: If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset - 16 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset Else ' Determine location for text TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) 16 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) 4 End If

por essa:

Código:: If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - 16 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset Else ' Determine location for text TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 4 'Guild TUT Text2Y = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 4 End If

Ja corrigir no tutorial.

por **~FullzDied** Dom Set 02, 2012 4:13 pm

Os [b] fazem parte?

por **M.Dutra** Dom Set 02, 2012 4:16 pm

Não [b] é código para fóruns... Quando testarem avisa se funcionou se funcionar ganha + 1

Atenciosamente, M.Dutra

por **Tayllor** Dom Set 02, 2012 4:32 pm

Bem aqui funfou, esperar se nos outros vai funfar também. ^^

por **~FullzDied** Dom Set 02, 2012 4:33 pm

Eu não consigo compilar meu server por causa de um error na frmServer

por **Tayllor** Dom Set 02, 2012 4:35 pm

na frmServer? mas o sistema de guild não meche com a frmServer. O.o

por **~FullzDied** Dom Set 02, 2012 4:37 pm

Eu sei mas é otro problema que todos os eclipse eu compilo ele sem fazer nada e ele baixado novinho vem logo um erro na FrmServer

por Alumary Dom Set 02, 2012 7:56 pm

vlw Tayllor ja fui la na Touch e vi qe tava errado seu topico mais vlws mesmo assim ja resolvi o poblema aqi ;D

@edit outro errozim ChkDir App.Path & "\Data", "spells" e ChkDir App.Path & "\Data", "guilds"

corrigindo

Código:: ChkDir App.Path & "\Data\", "spells" ChkDir App.Path & "\Data\", "guilds"

@reeedit

essa linha acusa na hora de compilar

Código:: TempPlayer(Index).tmpGuildInviteId = Player(Inviter_Index).GuildFileId expesificando não e a linha toda sim essa parte .tmpGuildInviteId =

@reeeeeeeeeditando

Código:: tmpGuildSlot As Long tmpGuildInviteSlot As Long tmpGuildInviteTimer As Long tem algo faltando? nao seri oo tmpGuildInviteId As Long ? kkkkkkkkkk concerta ae man

@reeeeeeeeeeeeeeeeeeditando

não entendi esse erro se puder ajudar '-'
[Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]

[Tens de ter uma conta e sessão iniciada para poderes visualizar este link]

por **KingSora** Qua Set 05, 2012 6:00 pm

Alumary editei seu post,coloquei os codigos dentro de cod para entenderem melhor sua correção.

por Khaws Ter maio 14, 2013 6:48 pm

Bom ~ Perdão por reviver o Topico, mas é necessário. Não tive tempo ainda de ler as regras y.y Mas Vou ler sim. : 3.

Vim trazer-lhes meu probleminha.

- ModGeneral

No Local onde se adicina

Código:: Call Set_Default_Guild_Ranks

Eu Fiz a Adição do Codigo, ao local correto. Mas no momento da compilação, ele acusa o tal erro. De Fato, o Set_Default_Guild_Ranks, não fora setado em nenhum Mod, Como ele vai dar Call nisso!?

Vou Tentar resolver por mim, ou apagar a linha ~

Já li os pos posteds, dos editeds, E ainda não adicionei o Arquivo da Guild, a qual o dono do topico postou. Mas irei ver ~

#Edit1: Não da mais erro no:

Código:: Call Set_Default_Guild_Ranks

Agora o Erro é na compilação. (Já li o post do Colega acima, mas não tem a solução.)

[Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]

#Edit2: USHauhshausasaush Obrigada! Alumary : ) Na Parte so Server tá OK!, Li seus postScript e deu certo. O Tayllor deveria editar e arrumar o post cod dele.

No meu erro citado a Cima, O Alumary arrumou vai ficar assim:

Serve Side ~ - ModTypes

Procure por :

Código:: tmpGuildSlot As Long tmpGuildInviteSlot As Long tmpGuildInviteTimer As Long

Logo abaixo antes do "End Type"

Adicione :

Código:: tmpGuildInviteId As Long

Resolvido S2 Gratz Alumary!#

Mais erros estarei editando e pedindo ajuda ushashaush S2

###Edit3: Tudo compilou perfeito :3 Até fiquei animada D: Mas quando emulo o server : -

[Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]

Aparece isso ~ Acho que no tutorial, faltou algo em relação a ModConstants, Isso no Serve e no Client Side. : Uma Public ~ E adds no Handle. Poderia rever o caso Tayllor? *-*

Vou salvar o Projeto e ver outros sistemas, e incrementos.

Aguardando Help ;*

#Desde Já Agradecida, Respondam o mais rapido que puderem S2#

por Conteúdo patrocinado

Sistema de Guild

Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild

Re: Sistema de Guild