Lucas Roberto Administrador
Mensagens : 711
| Assunto: Conta Vip [3 Chars] Por Tempo Influenciando Dano Sex 04 Nov 2011, 20:49 | |
| Nome: Sistema Conta Vip [3 Chars] Por Tempo Influenciando Dano Nivel de Dificuldade : 4/5 Utiliza: VisualBasic 6.0Como 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~SideNa 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 [Tens de ter uma conta e sessão iniciada para poderes visualizar este link]De Volta Ao Cliente~SideNo 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~SideNo 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 | |
|