Guild System

[William]

Edit: Fixed the font colors. As the leader of the guild, you'll get this text color on the guild:

Don't tell me that aint respect

And for those who are interested in some of the code xD I thouhgt it would be a lot less code at the begining.

Code:

Private Sub HandleSMsgLeaveGuild(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim i As Byte

  For i = 1 To MAX_GUILD_MEMBERS
    If GetVar(App.Path & "\accounts\GuildMembers.ini", Player(Index).Char(Player(Index).CharNum).GuildName, "GuildMember" & i) = GetPlayerName(Index) Then
        Call PutVar(App.Path & "\accounts\GuildMembers.ini", Player(Index).Char(Player(Index).CharNum).GuildName, "GuildMember" & i, "")
        Exit For
    End If
  Next i
  
  Player(Index).Char(Player(Index).CharNum).GuildName = vbNullString
  Player(Index).Char(Player(Index).CharNum).GuildAccess = 0
  
  For i = 1 To MAX_GUILD_MEMBERS
    Player(Index).Char(Player(Index).CharNum).GuildMembers(i) = vbNullString
  Next i
  Call SendGuildInfo(Index)
End Sub

Private Sub HandleSMsgKickMember(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim i As Byte, N As Byte
Dim Buffer() As Byte
Dim Name As String

  Buffer = FillBuffer(StartAddr, ByteLen)
  Name = GetStringFromBuffer(Buffer, True)
  
  N = FindPlayer(Name)
  For i = 1 To MAX_GUILD_MEMBERS
    If GetVar(App.Path & "\accounts\GuildMembers.ini", Player(N).Char(Player(N).CharNum).GuildName, "GuildMember" & i) = GetPlayerName(N) Then
        Call PutVar(App.Path & "\accounts\GuildMembers.ini", Player(N).Char(Player(N).CharNum).GuildName, "GuildMember" & i, "")
        Exit For
    End If
  Next i
  
  Player(N).Char(Player(N).CharNum).GuildName = vbNullString
  Player(N).Char(Player(N).CharNum).GuildAccess = 0
  
  For i = 1 To MAX_GUILD_MEMBERS
    Player(N).Char(Player(N).CharNum).GuildMembers(i) = vbNullString
  Next i
  Call SendGuildInfo(N)
End Sub

Private Sub HandleSMsgRecruit(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim i As Byte, N As Byte
Dim Buffer() As Byte
Dim Name As String, Access As Byte

  Buffer = FillBuffer(StartAddr, ByteLen)
  Name = GetStringFromBuffer(Buffer, True)
  Access = GetByteFromBuffer(Buffer, True)
  
  If Access = 0 Or Access = 1 Or Access = 2 Then
  Else
    Call PlayerMsg(Index, "The access can only be 0,1 and 2.", 0)
    Exit Sub
  End If
  
  If FindPlayer(Name) > 0 Then
    N = FindPlayer(Name)
  Else
    Call PlayerMsg(Index, "Player is not online or doesn't exist.", 0)
    Exit Sub
  End If
  
  If Player(N).Char(Player(N).CharNum).GuildName  vbNullString Then
    Call PlayerMsg(Index, "The player is already in a guild", 0)
    Exit Sub
  End If
  
  Player(N).Char(Player(N).CharNum).GuildName = Player(Index).Char(Player(Index).CharNum).GuildName
  Player(N).Char(Player(N).CharNum).GuildAccess = Access
  
  For i = 1 To MAX_GUILD_MEMBERS
    If GetVar(App.Path & "\accounts\GuildMembers.ini", Player(N).Char(Player(N).CharNum).GuildName, "GuildMember" & i) = vbNullString Then
      Call PutVar(App.Path & "\accounts\GuildMembers.ini", Player(N).Char(Player(N).CharNum).GuildName, "GuildMember" & i, GetPlayerName(N))
        Exit For
    End If
  Next i
  
  For i = 1 To MAX_GUILD_MEMBERS
    Player(N).Char(Player(N).CharNum).GuildMembers(i) = GetVar(App.Path & "\accounts\GuildMembers.ini", Player(N).Char(Player(N).CharNum).GuildName, "GuildMember" & i)
    'If i = MAX_GUILD_MEMBERS Then
    '    Call PlayerMsg(Index, "The guild is full. If you get this, there is a serious bug with the guild system..", 0)
    'End If
  Next i
  Call SendGuildInfo(N)
End Sub

Private Sub HandleSMsgRequestGuild(ByVal Index As Long, ByVal StartAddr As Long, ByVal ByteLen As Long, ByVal ExtraVar As Long)
Dim Buffer() As Byte
Dim Name As String
Dim f As Long

  Buffer = FillBuffer(StartAddr, ByteLen)
  Name = GetStringFromBuffer(Buffer, True)
  
  If Player(Index).Char(Player(Index).CharNum).GuildName  vbNullString Then
    Call PlayerMsg(Index, "Your already in a guild.", 0)
    Exit Sub
  End If
  
  If Not FindGuild(Name) Then
    f = FreeFile
    Open App.Path & "\accounts\guild.txt" For Append As #f
        Print #f, Name
    Close #f
  Else
    Call PlayerMsg(Index, "That guild already exists.", 0)
  End If
  
  
  Player(Index).Char(Player(Index).CharNum).GuildName = Name
  Player(Index).Char(Player(Index).CharNum).GuildAccess = 2
  
  Dim i As Byte
  For i = 1 To MAX_GUILD_MEMBERS
    If Player(Index).Char(Player(Index).CharNum).GuildMembers(i) = vbNullString Then
        Player(Index).Char(Player(Index).CharNum).GuildMembers(i) = GetPlayerName(Index)
        Call PutVar(App.Path & "\accounts\GuildMembers.ini", Name, "GuildMember" & 1, Player(Index).Char(Player(Index).CharNum).GuildMembers(1))
        Exit For
    End If
    If i = MAX_GUILD_MEMBERS Then
        Call PlayerMsg(Index, "The guild is full. If you get this, there is a serious bug with the guild system..", 0)
    End If
  Next i
  
  Call SendGuildInfo(Index)
End Sub

Sub SendGuildInfo(ByVal Index As Long)
Dim Packet As String, i As Byte, N As Byte, VarP As String
    Packet = "GUILDINFO" & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).GuildName & SEP_CHAR & Player(Index).Char(Player(Index).CharNum).GuildAccess
    
    If Player(Index).Char(Player(Index).CharNum).GuildName  vbNullString Then
        For i = 1 To MAX_GUILD_MEMBERS
            Packet = Packet & SEP_CHAR & GetVar(App.Path & "\accounts\GuildMembers.ini", Player(Index).Char(Player(Index).CharNum).GuildName, "GuildMember" & i)
        Next i
    Else
        For i = 1 To MAX_GUILD_MEMBERS
            Packet = Packet & SEP_CHAR & ""
        Next i
    End If
    
    If Player(Index).Char(Player(Index).CharNum).GuildName  vbNullString Then
        For i = 1 To MAX_GUILD_MEMBERS
            VarP = GetVar(App.Path & "\accounts\GuildMembers.ini", Player(Index).Char(Player(Index).CharNum).GuildName, "GuildMember" & 0 + i)
            frmServer.labelDD.Caption = frmServer.labelDD.Caption & "|" & VarP & "-" & FindPlayer(VarP)
            If FindPlayer(VarP) > 0 And VarP  vbNullString Then
                N = FindPlayer(VarP)
    
                If IsPlaying(N) = True Then
                    Packet = Packet & SEP_CHAR & 1
                Else
                    Packet = Packet & SEP_CHAR & 0
                End If
            Else
                Packet = Packet & SEP_CHAR & 0
            End If
        Next i
    Else
        For i = 1 To MAX_GUILD_MEMBERS
            Packet = Packet & SEP_CHAR & ""
        Next i
    End If

    Packet = Packet & SEP_CHAR & END_CHAR
    Call SendDataTo(Index, Packet)
End Sub

And god, a lot of things can be optimized. xD But now it all works..