1 [Tutorial]Vip Por Data 13/2/2012, 18:54
SkyAway
Membro V
[b]Bom, com este tutorial o "sistema de VIP" passa a ser retirado automaticamente. Todo o sistema funciona por datas.
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:
Agora, vá na frmChars e adicione 2 label, uma com o nome de lblVIP e a outra de lblDVIP.
Procure por:
Procure por:
[code]
' :::::::::::::::::::::::::::
' :: VIP editor packet ::
' :::::::::::::::::::::::::::
If (Parse(0) = "vipeditor") Then
If GetPlayerAccess(MyIndex) >= 5 Then
frmEditVIP.Visible = True
End If
End If
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:
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:
[code]
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
[/code]
Mude para:
[code]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
[/code]
Procure por:
[code]Sub JoinGame(ByVal Index As Long)
[/code]
Em cima de:
[code]' Mandar a flag, assim vão poder fazer algo
Call SendDataTo(Index, "INGAME" & END_CHAR)
[/code]
Adicione:
[code]Call UsersVIP(Index)
[/code]
E, embaixo (Call SendDataTo...) adicione:
[code]'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
[/code]
Procure por:
[code]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
[/code]
Abaixo adicione:
[code]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[/code]
CONTINUA [...]
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
- 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
- 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
- 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 ::
' :::::::::::::::::::::::::::
[code]
' :::::::::::::::::::::::::::
' :: VIP editor packet ::
' :::::::::::::::::::::::::::
If (Parse(0) = "vipeditor") Then
If GetPlayerAccess(MyIndex) >= 5 Then
frmEditVIP.Visible = True
End If
End If
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:
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:
[code]
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
[/code]
Mude para:
[code]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
[/code]
Procure por:
[code]Sub JoinGame(ByVal Index As Long)
[/code]
Em cima de:
[code]' Mandar a flag, assim vão poder fazer algo
Call SendDataTo(Index, "INGAME" & END_CHAR)
[/code]
Adicione:
[code]Call UsersVIP(Index)
[/code]
E, embaixo (Call SendDataTo...) adicione:
[code]'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
[/code]
Procure por:
[code]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
[/code]
Abaixo adicione:
[code]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[/code]
CONTINUA [...]
Última edição por SkyAway em 13/2/2012, 19:06, editado 1 vez(es)