Universo Games
Ola , Convidado



Você ainda não e cadastrado então cadastre-se e veja todas as atualizações no mundo rpg!!!
Universo Games

Suporte e Desenvolvimento só no Universo Games

Ola Convidado, Seja Bem vindo a equipe lhe deseja boa sorte no seu projeto!

Você não está conectado. Conecte-se ou registre-se

Conta Vip [3 Chars] Por Tempo Influenciando Dano

Ver o tópico anterior Ver o tópico seguinte Ir em baixo  Mensagem [Página 1 de 1]

Luucas Robeerto


Fundador
Fundador
Nome: Sistema Conta Vip [3 Chars] Por Tempo Influenciando Dano
Nivel de Dificuldade : 4/5
Utiliza: VisualBasic 6.0

Como funciona :

1- VIP Bronze
- vip os 3 chars
- 3X EXP
- + 5% de dano
- Por Tempo (exemplo 30 dias)

2- VIP Silver
- vip os 3 chars
- 5X EXP
- + 10% de dano
- Por Tempo (exemplo 30 dias)

3- VIP Gold
- vip os 3 chars
- 8X EXP
- + 20% de dano
- Por Tempo (exemplo 30 dias)


Cliente~Side

Na frmMirage, Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer), procure por:

Código:
Call CheckInput(0, KeyCode, Shift)
    If KeyCode = vbKeyF1 Then
        If Player(MyIndex).Access > 0 Then
            frmadmin.Visible = False
            frmadmin.Visible = True
        End If
    End If

Altere tudo para :

Código:
Call CheckInput(0, KeyCode, Shift)
    If KeyCode = vbKeyF1 Then
        If Player(MyIndex).Access > 3 Then
            frmadmin.Visible = False
            frmadmin.Visible = True
        End If
    End If

Na Mesma Sub Procure Por :

Código:
' The Guild Creator
    If KeyCode = vbKeyF4 Then
        If Player(MyIndex).Access > 0 Then
            frmGuild.Show vbModeless, frmMirage
        End If
    End If

Altere Para :

Código:
' The Guild Creator
    If KeyCode = vbKeyF4 Then
        If Player(MyIndex).Access > 3 Then
            frmGuild.Show vbModeless, frmMirage
        End If
    End If

Agora procure no modGameLogic por:

Código:
        ' // Moniter Admin Commands //
        If GetPlayerAccess(MyIndex) > 0 Then
            ' day night command
            If LCase(Mid(MyText, 1, 9)) = "/dianoite" Then
                If GameTime = TIME_DAY Then
                    GameTime = TIME_NIGHT
                Else
                    GameTime = TIME_DAY
                End If
                Call SendGameTime
                MyText = vbNullString
                Exit Sub
            End If

Altere tudo para :

Código:
        ' // Moniter Admin Commands //
        If GetPlayerAccess(MyIndex) > 3 Then
            ' day night command
            If LCase(Mid(MyText, 1, 9)) = "/dianoite" Then
                If GameTime = TIME_DAY Then
                    GameTime = TIME_NIGHT
                Else
                    GameTime = TIME_DAY
                End If
                Call SendGameTime
                MyText = vbNullString
                Exit Sub
            End If

Ainda no modGameLogic Procure por :

Código:
' // Mapper Admin Commands //
        If GetPlayerAccess(MyIndex) >= ADMIN_MAPPER Then
            ' Location
            If LCase(Mid(MyText, 1, 4)) = "/loc" Then
                Call SendRequestLocation
                MyText = vbNullString
                Exit Sub
            End If

Altere tudo para :

Código:
' // Mapper Admin Commands //
        If GetPlayerAccess(MyIndex) > 3 Then
            ' Location
            If LCase(Mid(MyText, 1, 4)) = "/loc" Then
                Call SendRequestLocation
                MyText = vbNullString
                Exit Sub
            End If

Ainda no modGameLogic Procure por :

Código:
' // Developer Admin Commands //
        If GetPlayerAccess(MyIndex) >= ADMIN_DEVELOPER Then
            ' Editing item request
            If Mid(MyText, 1, 9) = "/edititem" Or Mid(MyText, 1, 11) = "/itemeditor" Then
                Call SendRequestEditItem
                MyText = vbNullString
                Exit Sub
            End If

Altere tudo para :

Código:
' // Developer Admin Commands //
        If GetPlayerAccess(MyIndex) > 3 Then
            ' Editing item request
            If Mid(MyText, 1, 9) = "/edititem" Or Mid(MyText, 1, 11) = "/itemeditor" Then
                Call SendRequestEditItem
                MyText = vbNullString
                Exit Sub
            End If

[size=12pt]Server~Side[/size]

Procure no ModGameLogic Por :

Código:
        ' Ter certeza que não dar experiência menor que 0.
        If Exp < 0 Then
            Exp = 1
        End If

Abaixo Adicione :

Código:
' Vip Bronze
If GetPlayerAccess(Attacker) = 1 Then
Exp = Exp * 3
Else
Exp = Exp * 1
End If

' Vip Silver
If GetPlayerAccess(Attacker) = 2 Then
Exp = Exp * 5
Else
Exp = Exp * 1
End If

' Vip Gold
If GetPlayerAccess(Attacker) >= 3 Then
Exp = Exp * 8
Else
Exp = Exp * 1
End If

[Você precisa estar registrado e conectado para ver este link.]

De Volta Ao Cliente~Side

No ModClienteTCP Procure Por :

Código:
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

Altere Para :

Código:
Sub SendChangeVIP(ByVal Name As String, ByVal Data As String, ByVal Dias As Long, ByVal Access As Long)
Dim Packet As String
 
    Packet = "CVIP" & SEP_CHAR & Name & SEP_CHAR & Data & SEP_CHAR & Dias & SEP_CHAR & Access & END_CHAR
    Call SendData(Packet)
End Sub

No frmEditVip Procure por :

Código:
Private Sub cmdVIP_Click()
    'Verificações Toscas (Ou não? o_O)
    If GetPlayerAccess(MyIndex) <= 4 Then Exit Sub
   
    'Verificar se tem campos em branco (se quiserem, podem aprimorar aqui =^.^=)
    If txtPlayer.Text = vbNullString Or txtIVIP.Text = vbNullString Or txtDVIP.Text = vbNullString Then
        MsgBox ("Viado! Há campos em branco.")
        Exit Sub
    End If
   
    'Go, go VIP!
    Call SendChangeVIP(txtPlayer.Text, txtIVIP.Text, txtDVIP.Text)
End Sub

Mude para :

Código:
Private Sub cmdVIP_Click()
    'Verificações Toscas (Ou não? o_O)
    If GetPlayerAccess(MyIndex) <= 4 Then Exit Sub
   
    'Verificar se tem campos em branco (se quiserem, podem aprimorar aqui =^.^=)
    If txtPlayer.Text = vbNullString Or txtIVIP.Text = vbNullString Or txtDVIP.Text = vbNullString Then
        MsgBox ("Viado! Há campos em branco.")
        Exit Sub
    End If
   
   
    If Val(txtAccess.Text) > 3 Then
    MsgBox ("Viado! Só pode até acesso 3.")
    Exit Sub
    End If
   
    'Go, go VIP!
    Call SendChangeVIP(txtPlayer.Text, txtIVIP.Text, txtDVIP.Text, Val(txtAccess.Text))
End Sub

Crie um TextBox na frmEditVip com as Seguintes Propriedades :

Código:
Name = txtAccess
Text = Apague o que estiver escrito, Deixe em branco!

Server~Side

No ModGameLogic Procure Por :

Código:
'Verificar VIP

Substitua Tudo! A partir do 'Verificar VIP Até chegar no End Sub Por :

Código:
'Verificar VIP
    If GetPlayerVIP(Index) = "Sim" Then
        If DateDiff("d", GetPlayerInícioVIP(Index), Date) < GetPlayerDiasVIP(Index) Then
            If GetPlayerVIP(Index) = "Sim" Then
                    Call PlayerMsg(Index, "Obrigado por adiquirir o plano VIP, agora basta usufruir das vantagens!", 15)
            End If
        ElseIf DateDiff("d", GetPlayerInícioVIP(Index), Date) >= GetPlayerDiasVIP(Index) Then
            If GetPlayerVIP(Index) = "Sim" Then
                If GetPlayerAccess(Index) < 4 Then
                    Call SetPlayerVIP(Index, "Não")
                    Call SetPlayerAccess(Index, 0)
                    For i = 1 To MAX_CHARS
                    Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", 0)
                    Next i
                    Call PlayerMsg(Index, "Seus dias de plano VIP terminaram, regarregue!", 15)
                End If
            End If
        End If
    End If
End Sub

Agora no ModServerTCP Procure Por :

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

E substitua por :

Código:
Case "requesteditvip"
 
            If GetPlayerAccess(Index) < 4 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))
            Acesso = Val(Parse(4))
           
            If UBound(Parse) < 4 Then Exit Sub
           
            If GetPlayerAccess(Index) < 4 Then
                Call HackingAttempt(Index, "Admin Cloning")
                Exit Sub
            Else
                Call SetPlayerVIP(N, "Sim")
                Call SetPlayerAccess(N, Acesso)
                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) < 4 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

Ainda no ModServerTCP Procure por :

Código:
Sub HandleData(ByVal Index As Long, ByVal Data As String)

Abaixo Adicione :

Código:
Dim Acesso As Long

Agora na frmVip Crie um TextBox com as Seguintes Propriedades :

Código:
Name = txtAccess
Text = Apague o Text1! Deixe em branco...

ainda na frmVip Procure por :

Código:
Private Sub cmdVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    Call SetPlayerVIP(Index, "Sim")
    Call SetPlayerInícioVIP(Index, txtIVIP.text)
    Call SetPlayerDiasVIP(Index, txtDVIP.text)
    Call SetPlayerAccess(Index, 1)
    Call SendPlayerData(Index)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next
End Sub

Mude Para :

Código:
Private Sub cmdVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    If Val(txtAccess.Text) > 3 Then Exit Sub
   
    Call SetPlayerVIP(Index, "Sim")
    Call SetPlayerInícioVIP(Index, txtIVIP.text)
    Call SetPlayerDiasVIP(Index, txtDVIP.text)
    Call SetPlayerAccess(Index, Val(txtAccess.Text))
    Call SendPlayerData(Index)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next i

For i = 1 To MAX_CHARS
Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", Val(txtAccess.text))
Next i
End Sub

Procure no frmVIP Por :

Código:
Private Sub cmdTirarVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    Call SetPlayerVIP(Index, "Não")
    Call SetPlayerAccess(Index, 0)
    Call SetPlayerInícioVIP(Index, vbNullString)
    Call SetPlayerDiasVIP(Index, 0)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next
End Sub

Altere Para :

Código:
Private Sub cmdTirarVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    Call SetPlayerVIP(Index, "Não")
    Call SetPlayerAccess(Index, 0)
    Call SetPlayerInícioVIP(Index, vbNullString)
    Call SetPlayerDiasVIP(Index, 0)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next i

For i = 1 To MAX_CHARS
Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", 0)
Next i
End Sub

Agora na frmServer Procure Por :

Código:
If Command10.Caption = "Acesso" Then
        If Index > 0 Then
            If IsPlaying(Index) Then
                Call SetPlayerAccess(Index, scrlX.Value)
                Call SendPlayerData(Index)
                Call AddLog("O servidor modificou o acesso de " & GetPlayerName(Index) & ".", ADMIN_LOG)
                Call PlayerMsg(Index, "O servidor mudou seu acesso para " & scrlX.Value, White)
            End If

Altere Para :

Código:
If Command10.Caption = "Acesso" Then
        If Index > 0 Then
            If IsPlaying(Index) Then
                Call SetPlayerAccess(Index, scrlX.Value)
                For i = 1 To MAX_CHARS
                Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", scrlX.Value)
                Next i
                Call SendPlayerData(Index)
                Call AddLog("O servidor modificou o acesso de " & GetPlayerName(Index) & ".", ADMIN_LOG)
                Call PlayerMsg(Index, "O servidor mudou seu acesso para " & scrlX.Value, White)
            End If

No ModGameLogic Na Sub Sub AttackNpc(ByVal Attacker As Long, _
ByVal MapNpcNum As Long, _
ByVal Damage As Long)
Procure Por :

Código:
' Checar por armas
    If GetPlayerWeaponSlot(Attacker) > 0 Then
        N = GetPlayerInvItemNum(Attacker, GetPlayerWeaponSlot(Attacker))
    Else
        N = 0
    End If

Abaixo adicione :

Código:
' Danos Vips
If GetPlayerAccess(Attacker) = 1 Then
Damage = Damage + ((Damage * 5) / 100)
ElseIf GetPlayerAccess(Attacker) = 2 Then
Damage = Damage + ((Damage * 10) / 100)
ElseIf GetPlayerAccess(Attacker) >= 3 Then
Damage = Damage + ((Damage * 20) / 100)
End If

Agora no ModGameLogic Na Sub AttackPlayer(ByVal Attacker As Long, _
ByVal Victim As Long, _
ByVal Damage As Long)


Procure Por :

Código:
' Checar por arma
    If GetPlayerWeaponSlot(Attacker) > 0 Then
        N = GetPlayerInvItemNum(Attacker, GetPlayerWeaponSlot(Attacker))
    Else
        N = 0
    End If

Abaixo adicione :

Código:
' Danos Vips
If GetPlayerAccess(Attacker) = 1 Then
Damage = Damage + ((Damage * 5) / 100)
ElseIf GetPlayerAccess(Attacker) = 2 Then
Damage = Damage + ((Damage * 10) / 100)
ElseIf GetPlayerAccess(Attacker) >= 3 Then
Damage = Damage + ((Damage * 20) / 100)
End If

Ps : Testando & Aprovado!
Créditos : Guardian


_______________________________________________________________________________________________________

[Você precisa estar registrado e conectado para ver esta imagem.]
Spoiler:
[Você precisa estar registrado e conectado para ver esta imagem.]
[Você precisa estar registrado e conectado para ver esta imagem.]
[Você precisa estar registrado e conectado para ver esta imagem.]

[Você precisa estar registrado e conectado para ver esta imagem.]
[Você precisa estar registrado e conectado para ver esta imagem.]
http://universogamesmmo.forumeiros.com

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo  Mensagem [Página 1 de 1]

Permissão deste fórum:
Você não pode responder aos tópicos neste fórum