Suporte ao desenvolvimento de jogos!


    Vip por Tempo

    Compartilhe
    avatar
    jadieljr
    Banido
    Banido

    Mensagens : 38
    Créditos : 30

    Vip por Tempo

    Mensagem por jadieljr em Ter Nov 15, 2011 1:43 pm

    Bom, com este tutorial o "sistema de VIP" passa a ser retirado automaticamente. Todo o sistema funciona por datas.

    Lembre de ter o sistema de VIP primeiro para fazer esse tutorial
    :arrow: Sistema de VIP

    Cliente~Side

    Primeiramente, baixe a form anexada no final do post e adicione no seu projeto.
    Vá na frmAdmin e adicione um CommandButton e dê duplo clique nele. Adicione:
    Código:
        Call SendRequestEditVIP

    Agora, vá na frmChars e adicione 2 label, uma com o nome de lblVIP e a outra de lblDVIP.
    Procure por:
    Código:
        ' :::::::::::::::::::::::::::
        ' :: All characters packet ::
        ' :::::::::::::::::::::::::::
        If Parse(0) = "allchars" Then
            n = 1
           
            frmSendGetData.Hide
            frmChars.Show , frmMainMenu
           
            frmChars.lstChars.Clear
           
            For I = 1 To MAX_CHARS
                Name = Parse(n)
                Msg = Parse(n + 1)
                Level = Val(Parse(n + 2))
                charselsprite(I) = Val(Parse(n + 3))
               
                If Trim(Name) = vbNullString Then
                    frmChars.lstChars.AddItem "Lugar Livre"
                Else
                    frmChars.lstChars.AddItem Name & ", level " & Level & " " & Msg
                End If
               
                n = n + 4
            Next I
           
            frmChars.lstChars.ListIndex = 0
            Exit Sub
        End If

    Logo abaixo adicione:
    Código:
        ' :::::::::::::::::
        ' :: Data do VIP ::
        ' :::::::::::::::::
        If Parse(0) = "playerdvip" Then
            If Parse(1) = "Sim" Then
                    If Parse(3) - Val(Parse(2)) <= 0 Then
                            frmChars.lblVIP.Visible = False
                            frmChars.lblDVIP.Visible = False
                        Exit Sub
                    End If
                frmChars.lblVIP.Caption = "Plano VIP: " & Parse(1)
                frmChars.lblDVIP.Caption = "Você ainda têm " & Parse(3) - Val(Parse(2)) & " dia(s) de VIP."
            End If
        End If

    Procure por:
    Código:
    Sub SendSaveArrow(ByVal ArrowNum As Long)
    Dim Packet As String

        Packet = "SAVEARROW" & SEP_CHAR & ArrowNum & SEP_CHAR & Trim(Arrows(ArrowNum).Name) & SEP_CHAR & Arrows(ArrowNum).Pic & SEP_CHAR & Arrows(ArrowNum).Range & END_CHAR
        Call SendData(Packet)
    End Sub

    Abaixo adicione:
    Código:
    Sub SendRequestEditVIP()
    Dim Packet As String

        Packet = "REQUESTEDITVIP" & END_CHAR
        Call SendData(Packet)
    End Sub

    Sub SendChangeVIP(ByVal Name As String, ByVal Data As String, ByVal Dias As Long)
    Dim Packet As String

        Packet = "CVIP" & SEP_CHAR & Name & SEP_CHAR & Data & SEP_CHAR & Dias & END_CHAR
        Call SendData(Packet)
    End Sub

    Sub SendRemoveVIP(ByVal Name As String)
    Dim Packet As String

        Packet = "RVIP" & SEP_CHAR & Name & END_CHAR
        Call SendData(Packet)
    End Sub

    Procure por:
    Código:
        ' :::::::::::::::::::::::::::
        ' ::  Arrow editor packet  ::
        ' :::::::::::::::::::::::::::

    Em cima adicione:
    Código:
        ' :::::::::::::::::::::::::::
        ' ::  VIP editor packet  ::
        ' :::::::::::::::::::::::::::
        If (Parse(0) = "vipeditor") Then
            If GetPlayerAccess(MyIndex) >= 5 Then
                frmEditVIP.Visible = True
            End If
        End If

    Pronto, a parte do cliente já está pronta.

    Server~Side

    Baixe a form anexa no final do post e adicione no seu projeto.
    Agora vá na frmServer e em qualquer lugar adicione um CommandButton, dê duplo clique e adicione:
    Código:
        frmVIP.Visible = True

    Agora, continuando na frmServer, na aba 'Jogadores', na picStats, copiei qualquer label encontrada na pic e cole. Consequentemente irá criar a label CharInfo(23). Repita o processo mais 2 vezes, irá criar a CharInfo(24) e CharInfo(25).
    Agora, procure por:
    Código:
    Private Sub Command19_Click()
    Dim Index As Long

        If lvUsers.ListItems.Count = 0 Then Exit Sub
        Index = lvUsers.ListItems(lvUsers.SelectedItem.Index).text

        If IsPlaying(Index) = False Then Exit Sub
        CharInfo(0).Caption = "Conta: " & GetPlayerLogin(Index)
        CharInfo(1).Caption = "Personagem: " & GetPlayerName(Index)
        CharInfo(2).Caption = "Level: " & GetPlayerLevel(Index)
        CharInfo(3).Caption = "Hp: " & GetPlayerHP(Index) & "/" & GetPlayerMaxHP(Index)
        CharInfo(4).Caption = "Mp: " & GetPlayerMP(Index) & "/" & GetPlayerMaxMP(Index)
        CharInfo(5).Caption = "Sp: " & GetPlayerSP(Index) & "/" & GetPlayerMaxSP(Index)
        CharInfo(6).Caption = "Exp: " & GetPlayerExp(Index) & "/" & GetPlayerNextLevel(Index)
        CharInfo(7).Caption = "Acesso: " & GetPlayerAccess(Index)
        CharInfo(8).Caption = "PK: " & GetPlayerPK(Index)
        CharInfo(9).Caption = "Classe: " & Class(GetPlayerClass(Index)).Name
        CharInfo(10).Caption = "Sprite: " & GetPlayerSprite(Index)
        CharInfo(11).Caption = "Sexo: " & STR(Player(Index).Char(Player(Index).CharNum).Sex)
        CharInfo(12).Caption = "Mapa: " & GetPlayerMap(Index)
        CharInfo(13).Caption = "Guild: " & GetPlayerGuild(Index)
        CharInfo(14).Caption = "Guild Access: " & GetPlayerGuildAccess(Index)
        CharInfo(15).Caption = "For: " & GetPlayerstr(Index)
        CharInfo(16).Caption = "Def: " & GetPlayerDEF(Index)
        CharInfo(17).Caption = "Agi: " & GetPlayerSPEED(Index)
        CharInfo(18).Caption = "Int: " & GetPlayerMAGI(Index)
        CharInfo(19).Caption = "Pontos: " & GetPlayerPOINTS(Index)
        CharInfo(20).Caption = "Index: " & Index
        picStats.Visible = True
    End Sub

    Mude para:
    Código:
    Private Sub Command19_Click()
    Dim Index As Long

        If lvUsers.ListItems.Count = 0 Then Exit Sub
        Index = lvUsers.ListItems(lvUsers.SelectedItem.Index).text

        If IsPlaying(Index) = False Then Exit Sub
        CharInfo(0).Caption = "Conta: " & GetPlayerLogin(Index)
        CharInfo(1).Caption = "Personagem: " & GetPlayerName(Index)
        CharInfo(2).Caption = "Level: " & GetPlayerLevel(Index)
        CharInfo(3).Caption = "Hp: " & GetPlayerHP(Index) & "/" & GetPlayerMaxHP(Index)
        CharInfo(4).Caption = "Mp: " & GetPlayerMP(Index) & "/" & GetPlayerMaxMP(Index)
        CharInfo(5).Caption = "Sp: " & GetPlayerSP(Index) & "/" & GetPlayerMaxSP(Index)
        CharInfo(6).Caption = "Exp: " & GetPlayerExp(Index) & "/" & GetPlayerNextLevel(Index)
        CharInfo(7).Caption = "Acesso: " & GetPlayerAccess(Index)
        CharInfo(8).Caption = "PK: " & GetPlayerPK(Index)
        CharInfo(9).Caption = "Classe: " & Class(GetPlayerClass(Index)).Name
        CharInfo(10).Caption = "Sprite: " & GetPlayerSprite(Index)
        CharInfo(11).Caption = "Sexo: " & STR(Player(Index).Char(Player(Index).CharNum).Sex)
        CharInfo(12).Caption = "Mapa: " & GetPlayerMap(Index)
        CharInfo(13).Caption = "Guild: " & GetPlayerGuild(Index)
        CharInfo(14).Caption = "Guild Access: " & GetPlayerGuildAccess(Index)
        CharInfo(15).Caption = "For: " & GetPlayerstr(Index)
        CharInfo(16).Caption = "Def: " & GetPlayerDEF(Index)
        CharInfo(17).Caption = "Agi: " & GetPlayerSPEED(Index)
        CharInfo(18).Caption = "Int: " & GetPlayerMAGI(Index)
        CharInfo(19).Caption = "Pontos: " & GetPlayerPOINTS(Index)
        CharInfo(20).Caption = "Index: " & Index
        CharInfo(23).Caption = "VIP: " & GetPlayerVIP(Index)
        CharInfo(24).Caption = "Início do VIP: " & GetPlayerInícioVIP(Index)
        CharInfo(25).Caption = "Restando: " & GetPlayerDiasVIP(Index)
        picStats.Visible = True
    End Sub

    Procure por:
    Código:
    Sub JoinGame(ByVal Index As Long)

    Em cima de:
    Código:
        ' Mandar a flag, assim vão poder fazer algo
        Call SendDataTo(Index, "INGAME" & END_CHAR)

    Adicione:
    Código:
        Call UsersVIP(Index)

    E, embaixo (Call SendDataTo...) adicione:
    Código:
        'Verificar VIP
        If GetPlayerVIP(Index) = "Sim" Then
            If DateDiff("d", GetPlayerInícioVIP(Index), Date) < GetPlayerDiasVIP(Index) Then
                If GetPlayerVIP(Index) = "Sim" Then
                    If GetPlayerAccess(Index) = 0 Then
                        Call SetPlayerAccess(Index, 1)
                        Call PlayerMsg(Index, "Obrigado por adiquirir o plano VIP, agora basta usufruir das vantagens!", 15)
                    End If
                End If
            ElseIf DateDiff("d", GetPlayerInícioVIP(Index), Date) >= GetPlayerDiasVIP(Index) Then
                If GetPlayerVIP(Index) = "Sim" Then
                    If GetPlayerAccess(Index) = 1 Then
                        Call SetPlayerVIP(Index, "Não")
                        Call SetPlayerAccess(Index, 0)
                        Call PlayerMsg(Index, "Seus dias de plano VIP terminaram, regarregue!", 15)
                    End If
                End If
            End If
        End If

    Procure por:
    Código:
    Public Sub ShowPLR(ByVal Index As Long)
        Dim ls As ListItem

        On Error Resume Next

        If frmServer.lvUsers.ListItems.Count > 0 And IsPlaying(Index) = True Then
            frmServer.lvUsers.ListItems.Remove Index
        End If

        Set ls = frmServer.lvUsers.ListItems.add(Index, , Index)

        If IsPlaying(Index) = False Then
            ls.SubItems(1) = vbNullString
            ls.SubItems(2) = vbNullString
            ls.SubItems(3) = vbNullString
            ls.SubItems(4) = vbNullString
            ls.SubItems(5) = vbNullString
        Else
            ls.SubItems(1) = GetPlayerLogin(Index)
            ls.SubItems(2) = GetPlayerName(Index)
            ls.SubItems(3) = GetPlayerLevel(Index)
            ls.SubItems(4) = GetPlayerSprite(Index)
            ls.SubItems(5) = GetPlayerAccess(Index)
        End If

    End Sub

    Abaixo adicione:
    Código:
    Public Sub UsersVIP(ByVal Index As Long)
    Dim ls As ListItem

        On Error Resume Next

        If frmVIP.lvUsersVIP.ListItems.Count > 0 And IsPlaying(Index) = True Then
            frmVIP.lvUsersVIP.ListItems.Remove Index
        End If

        Set ls = frmVIP.lvUsersVIP.ListItems.add(Index, , Index)

        If IsPlaying(Index) = False Then
            ls.SubItems(1) = vbNullString
            ls.SubItems(2) = vbNullString
            ls.SubItems(3) = vbNullString
            ls.SubItems(4) = vbNullString
        Else
            ls.SubItems(1) = GetPlayerLogin(Index)
            ls.SubItems(2) = GetPlayerVIP(Index)
            ls.SubItems(3) = GetPlayerInícioVIP(Index)
            ls.SubItems(4) = GetPlayerDiasVIP(Index) & " dias"
        End If
    End Sub

    Procure na Sub InitServer() por:
    Código:
        For i = 1 To MAX_PLAYERS
            Call ShowPLR(i)
        Next

    Mude para:
    Código:
        For i = 1 To MAX_PLAYERS
            Call ShowPLR(i)
            Call UsersVIP(i)
        Next

    Procure por:
    Código:
    Public Sub RemovePLR()
        frmServer.lvUsers.ListItems.Clear
    End Sub

    Abaixo adicione:
    Código:
    Public Sub RemoveUsersVIP()
        frmVIP.lvUsersVIP.ListItems.Clear
    End Sub

    Procure por na Sub LeftGame por:
    Código:
            Call SavePlayer(Index)
            Call TextAdd(frmServer.txtText(0), GetPlayerName(Index) & " saiu do " & GAME_NAME & ".", True)
            Call SendLeftGame(Index)
            Call RemovePLR

    Abaixo adicione:
    Código:
            Call RemoveUsersVIP

    Procure por:
    Código:
    Sub HandleData(ByVal Index As Long, ByVal Data As String)
        Dim Parse() As String ' MODO DE SEGURANÇA -- "Descomente" para DESLIGÁ-LO, comente para LIGÁ-LO
        Dim Name As String
        Dim Password As String
        Dim Sex As Long
        Dim Class As Long
        Dim CharNum As Long
        Dim Msg As String
        Dim MsgTo As Long
        Dim Dir As Long
        Dim InvNum As Long
        Dim Amount As Long
        Dim Damage As Long
        Dim PointType As Byte
        Dim PointQuant As Integer
        Dim Movement As Long
        Dim i As Long, N As Long, x As Long, y As Long, f As Long
        Dim MapNum As Long
        Dim s As String
        Dim ShopNum As Long, ItemNum As Long
        Dim DurNeeded As Long, GoldNeeded As Long
        Dim z As Long
        Dim Packet As String
        Dim o As Long

    Mude para:
    Código:
    Sub HandleData(ByVal Index As Long, ByVal Data As String)
        Dim Parse() As String ' MODO DE SEGURANÇA -- "Descomente" para DESLIGÁ-LO, comente para LIGÁ-LO
        Dim Name As String
        Dim Password As String
        Dim VIP As String
        Dim InícioVIP As String
        Dim DiasVIP As Long
        Dim Sex As Long
        Dim Class As Long
        Dim CharNum As Long
        Dim Msg As String
        Dim MsgTo As Long
        Dim Dir As Long
        Dim InvNum As Long
        Dim Amount As Long
        Dim Damage As Long
        Dim PointType As Byte
        Dim PointQuant As Integer
        Dim Movement As Long
        Dim i As Long, N As Long, x As Long, y As Long, f As Long
        Dim MapNum As Long
        Dim s As String
        Dim ShopNum As Long, ItemNum As Long
        Dim DurNeeded As Long, GoldNeeded As Long
        Dim z As Long
        Dim Packet As String
        Dim o As Long

    Procure na Sub HandleData, Case "newfaccountied" por:
    Código:
                            Call AddAccount(Index, Name, Password)

    Mude para:
    Código:
                            Call AddAccount(Index, Name, Password, VIP, InícioVIP, DiasVIP)

    Procure na Sub HandleData, Case "logination" por:
    Código:
                        Packs = "MAXINFO" & SEP_CHAR
                        Packs = Packs & GAME_NAME & SEP_CHAR
                        Packs = Packs & MAX_PLAYERS & SEP_CHAR
                        Packs = Packs & MAX_ITEMS & SEP_CHAR
                        Packs = Packs & MAX_NPCS & SEP_CHAR
                        Packs = Packs & MAX_SHOPS & SEP_CHAR
                        Packs = Packs & MAX_SPELLS & SEP_CHAR
                        Packs = Packs & MAX_MAPS & SEP_CHAR
                        Packs = Packs & MAX_MAP_ITEMS & SEP_CHAR
                        Packs = Packs & MAX_MAPX & SEP_CHAR
                        Packs = Packs & MAX_MAPY & SEP_CHAR
                        Packs = Packs & MAX_EMOTICONS & SEP_CHAR
                        Packs = Packs & MAX_SPEECH & SEP_CHAR
                        Packs = Packs & END_CHAR
                        Call SendDataTo(Index, Packs)
                        Call LoadPlayer(Index, Name)
                        Call SendChars(Index)

    Abaixo adicione:
    Código:
                        Call SendDataVIP(Index)

    Procure na Sub HandleData, Case "addachara" por:
    Código:
                    Call AddChar(Index, Name, Sex, Class, CharNum)
                    Call SavePlayer(Index)
                    Call AddLog("O personagem " & Name & " foi adicionado na conta de " & GetPlayerLogin(Index) & ".", PLAYER_LOG)
                    Call SendChars(Index)

    Abaixo adicione:
    Código:
                    Call SendDataVIP(Index)

    Procure na Sub HandleData, Case "delimbocharu" por:
    Código:
                    Call DelChar(Index, CharNum)
                    Call AddLog("Personagem deletado na conta de " & GetPlayerLogin(Index) & ".", PLAYER_LOG)
                    Call SendChars(Index)

    Abaixo adicione:
    Código:
                    Call SendDataVIP(Index)

    Procure por:
    Código:
    Sub SendChars(ByVal Index As Long)
        Dim Packet As String
        Dim i As Long

        Packet = "ALLCHARS" & SEP_CHAR

        For i = 1 To MAX_CHARS
            Packet = Packet & Trim$(Player(Index).Char(i).Name) & SEP_CHAR & Trim$(Class(Player(Index).Char(i).Class).Name) & SEP_CHAR & Player(Index).Char(i).Level & SEP_CHAR & Player(Index).Char(i).Sprite & SEP_CHAR
        Next

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

    Abaixo adicione:
    Código:
    Sub SendDataVIP(ByVal Index As Long)
        Dim Packet As String
        Dim d As Long
       
        If GetPlayerVIP(Index) = "Sim" Then
            d = DateDiff("d", GetPlayerInícioVIP(Index), Now)
        Else
            Exit Sub
        End If

        Packet = "PLAYERDVIP" & SEP_CHAR & GetPlayerVIP(Index) & SEP_CHAR & d & SEP_CHAR & GetPlayerDiasVIP(Index) & END_CHAR
        Call SendDataTo(Index, Packet)
    End Sub

    Procure por:
    Código:
    Sub AddAccount(ByVal Index As Long, _
      ByVal Name As String, _
      ByVal Password As String)
        Dim i As Long

        Player(Index).Login = Name
        Player(Index).Password = Password

        For i = 1 To MAX_CHARS
            Call ClearChar(Index, i)
        Next

        Call SavePlayer(Index)
    End Sub

    Mude para:
    Código:
    Sub AddAccount(ByVal Index As Long, _
      ByVal Name As String, _
      ByVal Password As String, _
      ByVal VIP As String, _
      ByVal InícioVIP As String, _
      ByVal DiasVIP As Long)
        Dim i As Long

        Player(Index).Login = Name
        Player(Index).Password = Password
        Player(Index).VIP = VIP
        Player(Index).InícioVIP = InícioVIP
        Player(Index).DiasVIP = DiasVIP

        For i = 1 To MAX_CHARS
            Call ClearChar(Index, i)
        Next

        Call SavePlayer(Index)
    End Sub

    Procure por:
    Código:
    Sub LoadPlayer(ByVal Index As Long, _
      ByVal Name As String)
        Dim FileName As String
        Dim i As Long
        Dim N As Long

        Call ClearPlayer(Index)
        FileName = App.Path & "\Contas" & Trim$(Name) & ".ini"
        Player(Index).Login = GetVar(FileName, "GENERAL", "Login")
        Player(Index).Password = GetVar(FileName, "GENERAL", "Password")
        Player(Index).Pet.Alive = NO

    Mude para:
    Código:
    Sub LoadPlayer(ByVal Index As Long, _
      ByVal Name As String)
        Dim FileName As String
        Dim i As Long
        Dim N As Long

        Call ClearPlayer(Index)
        FileName = App.Path & "\Contas" & Trim$(Name) & ".ini"
        Player(Index).Login = GetVar(FileName, "GENERAL", "Login")
        Player(Index).Password = GetVar(FileName, "GENERAL", "Password")
        Player(Index).VIP = GetVar(FileName, "GENERAL", "VIP")
        Player(Index).InícioVIP = GetVar(FileName, "GENERAL", "InícioVIP")
        Player(Index).DiasVIP = Val(GetVar(FileName, "GENERAL", "DiasVIP"))
        Player(Index).Pet.Alive = NO

    Procure por:
    Código:
    Sub SavePlayer(ByVal Index As Long)
        Dim FileName As String
        Dim i As Long
        Dim N As Long

        FileName = App.Path & "\Contas" & Trim$(Player(Index).Login) & ".ini"
        Call PutVar(FileName, "GENERAL", "Login", Trim$(Player(Index).Login))
        Call PutVar(FileName, "GENERAL", "Password", Trim$(Player(Index).Password

    Mude para:
    Código:
    Sub SavePlayer(ByVal Index As Long)
        Dim FileName As String
        Dim i As Long
        Dim N As Long

        FileName = App.Path & "\Contas" & Trim$(Player(Index).Login) & ".ini"
        Call PutVar(FileName, "GENERAL", "Login", Trim$(Player(Index).Login))
        Call PutVar(FileName, "GENERAL", "Password", Trim$(Player(Index).Password))
        Call PutVar(FileName, "GENERAL", "VIP", Trim$(Player(Index).VIP))
        Call PutVar(FileName, "GENERAL", "InícioVIP", Trim$(Player(Index).InícioVIP))
        Call PutVar(FileName, "GENERAL", "DiasVIP", STR(Player(Index).DiasVIP))

    Procure por:
    Código:
    Type AccountRec

        ' Conta
        Login As String * NAME_LENGTH
        Password As String * NAME_LENGTH

    Mude para:
    Código:
    Type AccountRec

        ' Conta
        Login As String * NAME_LENGTH
        Password As String * NAME_LENGTH
        VIP As String
        InícioVIP As String
        DiasVIP As Long

    Procure por:
    Código:
    Sub ClearPlayer(ByVal Index As Long)
        Dim i As Long
        Dim N As Long

        Player(Index).Login = vbNullString
        Player(Index).Password = vbNullString

    Mude para:
    Código:
    Sub ClearPlayer(ByVal Index As Long)
        Dim i As Long
        Dim N As Long

        Player(Index).Login = vbNullString
        Player(Index).Password = vbNullString
        Player(Index).VIP = "Não"
        Player(Index).InícioVIP = "00/00/0000"
        Player(Index).DiasVIP = 0

    Procure por:
    Código:
    ' //////////////////////
    ' // PLAYER FUNCTIONS //
    ' //////////////////////
    Function GetPlayerLogin(ByVal Index As Long) As String
        GetPlayerLogin = Trim$(Player(Index).Login)
    End Function

    Abaixo adicione:
    Código:
    'VIP
    Function GetPlayerVIP(ByVal Index As Long) As String
        GetPlayerVIP = Trim$(Player(Index).VIP)
    End Function

    Sub SetPlayerVIP(ByVal Index As Long, _
      ByVal VIP As String)
        Player(Index).VIP = VIP
    End Sub

    'Início VIP
    Function GetPlayerInícioVIP(ByVal Index As Long) As String
        GetPlayerInícioVIP = Trim$(Player(Index).InícioVIP)
    End Function

    Sub SetPlayerInícioVIP(ByVal Index As Long, _
      ByVal InícioVIP As String)
        Player(Index).InícioVIP = InícioVIP
    End Sub

    'Dias VIP
    Function GetPlayerDiasVIP(ByVal Index As Long) As Long
        GetPlayerDiasVIP = Player(Index).DiasVIP
    End Function

    Sub SetPlayerDiasVIP(ByVal Index As Long, _
      ByVal DiasVIP As Long)
        Player(Index).DiasVIP = DiasVIP
    End Sub

    Procure por:
    Código:
            Case "prompt"

                If scriptING = 1 Then
                    Myscript.ExecuteStatement "scripts\Principal.txt", "PlayerPrompt " & Index & "," & Val(Parse(1)) & "," & Val(Parse(2))
                End If

                Exit Sub

    Abaixo adicione:
    Código:
            Case "requesteditvip"

                If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
                    Call HackingAttempt(Index, "Admin Cloning")
                    Exit Sub
                End If

                Call SendDataTo(Index, "VIPEDITOR" & END_CHAR)
                Exit Sub
               
            Case "cvip"
           
                N = FindPlayer(Parse(1))
                InícioVIP = Parse(2)
                DiasVIP = Val(Parse(3))
               
                If UBound(Parse) < 3 Then Exit Sub
               
                If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
                    Call HackingAttempt(Index, "Admin Cloning")
                    Exit Sub
                Else
                    Call SetPlayerVIP(N, "Sim")
                    Call SetPlayerAccess(N, 1)
                    Call SetPlayerInícioVIP(N, InícioVIP)
                    Call SetPlayerDiasVIP(N, DiasVIP)
                    Call SavePlayer(N)
                End If
               
            Exit Sub
           
            Case "rvip"
           
                N = FindPlayer(Parse(1))
               
                If UBound(Parse) < 1 Then Exit Sub
               
                If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
                    Call HackingAttempt(Index, "Admin Cloning")
                    Exit Sub
                Else
                    Call SetPlayerVIP(N, "Não")
                    Call SetPlayerAccess(N, 0)
                    Call SetPlayerInícioVIP(N, vbNullString)
                    Call SetPlayerDiasVIP(N, 0)
                    Call SavePlayer(N)
                End If
               
            Exit Sub

    Se não me esqueci de nada, vai funcionar direito, caso contário, reporte!

    Lembrando que você precisa ter em seu jogo o sistema VIP

    Se funcionar direito, avisem-me, para podermos aprova-lo Very Happy


    Créditos: Lenon
    avatar
    BrunoFox
    Aldeia Friend
    Aldeia Friend

    Mensagens : 1552
    Créditos : 32

    Re: Vip por Tempo

    Mensagem por BrunoFox em Ter Nov 15, 2011 2:24 pm

    Valeu Very Happy +1 por disponibilizar Successful muito bom esse.


    _________________

    -=(У$trØy£r$)=-
    Novato
    Novato

    Mensagens : 5
    Créditos : 2

    Re: Vip por Tempo

    Mensagem por -=(У$trØy£r$)=- em Dom Set 23, 2012 9:43 pm

    Erro cade o Multiplicador de xp?

    tipo esse

    'Exp Vip 1
    If Exp = 1 Then
    Exp = Exp * 3
    End If

    lucaskfuri
    Novato
    Novato

    Mensagens : 19
    Créditos : 0

    Re: Vip por Tempo

    Mensagem por lucaskfuri em Qui Out 12, 2017 12:08 am

    Alguem poderia me passar o form?

    ayan13
    Novato
    Novato

    Mensagens : 1
    Créditos : 0

    Re: Vip por Tempo

    Mensagem por ayan13 em Dom Nov 26, 2017 6:47 pm

    Cadê a form?

    Conteúdo patrocinado

    Re: Vip por Tempo

    Mensagem por Conteúdo patrocinado


      Data/hora atual: Sab Jan 20, 2018 3:57 am