Bueno chicos... Buscando algunos tutos para aportar a la comunidad, encontre este, Sirve para agregarle sistema de retos 1vs1 a tu alkon 13.0...
[b]Abran Server.vbp
Busquen:
[codigo]Call WriteMultiMessage(VictimIndex, eMessages.UserKill, AttackerIndex)[/codigo]
Y abajo pongan:
[codigo] If UserList(AttackerIndex).flags.EnReto = 1 Then
UserList(AttackerIndex).Stats.GLD = UserList(AttackerIndex).Stats.GLD + retos.oro
Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El usuario " & UserList(AttackerIndex).name & " ha ganado el reto.", FontTypeNames.FONTTYPE_INFO))
Call TirarTodo(VictimIndex)
Call WarpUserChar(VictimIndex, 1, 50, 50, True)
Call WarpUserChar(AttackerIndex, 1, 50, 50, True)
retos.hayReto = 0
retos.oro = 0
retos.retadorA= ""
retos.retadorB= ""
frmmain.timerretos.enabled = false
End If[/codigo]
Busquen:
[codigo]Private Sub HandleMeditate(byval userindex as integer)[/codigo]
Y arriva pongan:
[codigo] Private Sub HandleNicoRetos(ByVal userindex As Integer)
Rem Sistema de Retos 1vs1 (/RETAR)
Rem 18/08/2010
Rem para Nico (A)
If UserList(userindex).incomingData.length < 3 Then
Err.Raise UserList(userindex).incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo Errhandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim buffer As New clsByteQueue
Call buffer.CopyBuffer(.incomingData)
'Remove packet ID
Call buffer.ReadByte
Dim userneim As String
Dim auser As Integer
Dim oro As Long
userneim = buffer.ReadASCIIString
auser = NameIndex(userneim)
oro = buffer.ReadLong
If auser <= 0 Then
call writeconsolemsg(userindex, "Usuario Offline", fonttypenames.fonttype_info)
elseIf UserList(userindex).flags.Muerto Then
Call WriteConsoleMsg(userindex, "Estás muerto", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(auser).flags.Muerto Then
Call WriteConsoleMsg(userindex, "Está muerto", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(userindex).Counters.Pena > 0 Then
Call WriteConsoleMsg(userindex, "Estás preso", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(auser).Counters.Pena > 0 Then
Call WriteConsoleMsg(userindex, "Está preso", FontTypeNames.FONTTYPE_INFO)
elseIf MapInfo(UserList(userindex).Pos.Map).Pk = True Then
Call WriteConsoleMsg(userindex, "No puedes solicitarle a alguien duelear si no estas en una zona segura!", FontTypeNames.FONTTYPE_INFO)
elseIf MapInfo(UserList(auser).Pos.Map).Pk = True Then
Call WriteConsoleMsg(userindex, "No puedes solicitarle a alguien duelear si él no esta en una zona segura!", FontTypeNames.FONTTYPE_INFO)
elseIf oro > UserList(userindex).Stats.GLD Then
Call WriteConsoleMsg(userindex, "No puedes retar por mas de el oro qe tienes!", FontTypeNames.FONTTYPE_INFOBOLD)
elseIf oro > UserList(auser).Stats.GLD Then
Call WriteConsoleMsg(userindex, "El otro usuario no tiene el oro suficiente!", FontTypeNames.FONTTYPE_INFOBOLD)
elseIf Retos.hayReto = 1 Then
Call WriteConsoleMsg(userindex, "Ya hay un reto en marcha, espere a que finalize!", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(userindex).Stats.ELV < 35 Then
Call WriteConsoleMsg(userindex, "Minimo nivel para duelear : 35", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(auser).Stats.ELV < 35 Then
Call WriteConsoleMsg(userindex, "No puedes retar a alguien menor de nivel 35!", FontTypeNames.FONTTYPE_INFO)
elseif oro < 200000 Then
Call WriteConsoleMsg(userindex, "No puedes retar por menos de 200000 monedas!", FontTypeNames.FONTTYPE_INFOBOLD)
elseIf UserList(userindex).flags.recibiosolicitud = 1 Then
Call WriteConsoleMsg(userindex, "No puedes retar a alguien si te solicitaron duelear!", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(auser).flags.recibiosolicitud = 1 Then
Call WriteConsoleMsg(userindex, "No puedes retar a alguien si le solicitaron duelear!", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(userindex).flags.enviosolicitud = 1 Then
Call WriteConsoleMsg(userindex, "No puedes retar a alguien si ya solicitaste duelear!", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(auser).flags.enviosolicitud = 1 Then
Call WriteConsoleMsg(userindex, "No puedes retar a alguien si a ese envio solicitud de duelear a otro usuario!", FontTypeNames.FONTTYPE_INFO)
else
UserList(auser).flags.recibiosolicitud = 1
retos.oro = oro
UserList(userindex).flags.enviosolicitud = 1
Retos.RetadorA = userindex
Retos.RetadorB= auser
Call WriteConsoleMsg(auser, "El usuario " & UserList(userindex).name & " de nivel " & UserList(userindex).Stats.ELV & " y de clase " & UserList(userindex).clase & UserList(userindex).raza & " te ha retado a un duelo de modalidad 1 vs 1 por " & Retos.oro & " monedas de oro y por los items del inventario, si deseas aceptar teclea /ACEPTAR " & UserList(userindex).name & "", FontTypeNames.FONTTYPE_INFO)
Call UserList(userindex).incomingData.CopyBuffer(buffer)
Errhandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
Private Sub HandleNicoAceptar(ByVal userindex As Integer)
Rem *************************************
Rem Sistema de Retos 1vs1 (/RETAR)
Rem 18/08/2010
Rem para Nico (A)
Rem *************************************
If UserList(userindex).incomingData.length < 3 Then
Err.Raise UserList(userindex).incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo Errhandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim buffer As New clsByteQueue
Call buffer.CopyBuffer(.incomingData)
'Remove packet ID
Call buffer.ReadByte
Dim userneim As String
Dim auser As Integer
userneim = buffer.ReadASCIIString
auser = NameIndex(userneim)
If auser <= 0 Then
call writeconsolemsg(userindex, "Usuario Offline.", fonttypenames.fonttype_infobold)
elseIf UserList(auser).flags.enviosolicitud = 0 Then
Call WriteConsoleMsg(userindex, "Ese usuario no mando solicitud de reto", FontTypeNames.FONTTYPE_INFO)
elseIf UserList(userindex).flags.recibiosolicitud = 0 Then
Call WriteConsoleMsg(userindex, "Nadie te ofreció reto", FontTypeNames.FONTTYPE_INFO)
else
retos.hayReto = 1
Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El usuario " & UserList(userindex).name & " y " & UserList(auser).name & " van a combatir en un reto por " & retos.oro & " monedas de oro.", FontTypeNames.FONTTYPE_INFO))
Dim xplayerwan, yplayerwan, xplayerchu, yplayerchu As Byte
xplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerUno"))
yplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerUno"))
xplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerDos"))
yplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerDos"))
Call WarpUserChar(userindex, 275, xplayerwan, yplayerwan, True)
Call WarpUserChar(auser, 275, xplayerchu, yplayerchu, True)
UserList(userindex).Stats.GLD = UserList(userindex).Stats.GLD - retos.oro
UserList(auser).Stats.GLD = UserList(auser).Stats.GLD - retos.oro
UserList(userindex).flags.EnReto = 1
UserList(auser).flags.EnReto = 1
frmmain.timerRETOS.enabled = true
Call UserList(userindex).incomingData.CopyBuffer(buffer)
Errhandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub[/codigo]
Lugeo, creamos un timer con estas propiedades(en el frmmain)
[codigo]Name = TimerRetos
Interval = 60000
Enabled = False[/codigo]
Y de codigo le ponemos
[codigo]if hayReto = 0 then exit sub
If Retos.Counter < 5 then
retos.counter = retos.counter + 1
else
call warpuserchar(retos.retadorA, 1 , 50 , 50, true)
call warpuserchar(retos.retadorB, 1, 50 , 50, true
call senddata(sendtarget.toall, 0, preparemessageconsolemsg("El duelo entre " & userlist(retador1).name & " Y " & userlist(retador2).name & " ha llegado a los 5 minutos sin ningún ganador!.", fonttypenames.fonttype_talk)
userlist(retos.retadorA).stats.gld = userlist(retos.retadorA).stats.gld + retos.Oro
userlist(retos.retadorB).stats.gld = userlist(retos.retadorB).stats.gld + retos.Oro
timerRETOS.enabled = false
retos.hayreto = 0
retos.retadorA = 0
Retos.RetadoRB = 0
end if[/codigo]
Vayan al mòdulo declaraciones y abajo de option explicit pongan:
[codigo]Public Type Reto
hayReto As Byte
retadorA as integer
retadorB as integer
oro As Long
counter as byte
End Type
Public retos As Reto[/codigo]
Luego Busquen:
[codigo] 'mato los comercios seguros[/codigo]
Y arriva ponen:
[codigo]if userlist(userindex).flags.enreto = 1 then
call senddata(sendtarget.toall, 0 , preparemessageconsolemsg("El usuario " & userlist(userindex).name & " ha deslogeado en reto", fonttypenames.fonttype_talk)
call warpuserchar(userindex, 1 , 50 , 50)
frmmain.timerRETOS.enabled = false
end if[/codigo]
Buscar:
[codigo]Case ClientPacketID.Meditate '/MEDITAR
Call HandleMeditate(userindex)[/codigo]
Abajo pongan:
[codigo]Case ClientPacketID.Retar '/RETO
Call HandleNicoRetos(userindex)
Case ClientPacketID.AReto '/ACEPTAR
Call HandleNicoAceptar(userindex)[/codigo]
Busquen:
[codigo]Meditate '/MEDITAR[/codigo]
Abajo Pongan:
[codigo] Retar '/RETO
AReto '/ACEPTAR[/codigo]
Busquen:
[codigo]type userflags[/cogigo]
Abajo Pongan:
[codigo]EnReto as byte
recibioSolicitud as byte
envioSolicitud as byte[/codigo]
Al fin terminamos con servidor!
Ahora vamos al cliente:
Busquen:
[codigo]Meditate '/MEDITAR[/codigo]
Abajo Ponene:
[codigo]
Retar '/RETO
AReto '/ACEPTAR[/codigo]
Busquen:
[codigo] Case "/PENAS"
If notNullArguments Then
Call WritePunishments(ArgumentosRaw)
Else
'Avisar que falta el parametro
Call ShowConsoleMsg("Faltan parámetros. Utilice /penas NICKNAME.")
End If[/codigo]
Abajo Pongan:
[codigo]
Case "/RETAR"
If notNullArguments And CantidadArgumentos >= 2 Then
If ArgumentosAll(1) > 200000000000 Then
Call ShowConsoleMsg("Solo se retar por un máximo de 200000000000 monedas de oro.")
Else
Call WriteNicoRetos(ArgumentosAll(0), ArgumentosAll(1))
End If
End If
Case "/ACEPTAR"
If notNullArguments Then
Call WriteNicoAceptar(ArgumentosRaw)
Else
'Avisar que falta el parametro
Call ShowConsoleMsg("Faltan parámetros. Utilice /ACEPTAR NICKNAME.")
End If[/codigo]
Busquen:
[codigo]Public Sub WritePunishments(ByVal UserName As String, byval oro as long)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'Writes the "Punishments" message to the outgoing data buffer
'***************************************************
With outgoingData
Call .WriteByte(ClientPacketID.Punishments)
Call .WriteASCIIString(UserName)
End With
End Sub[/codigo]
Arriva Ponen:
[codigo] Call .WriteASCIIString(Userneim)
call .writelong(oro)
End With
End Sub
Public Sub WriteNicoAceptarByVal UserNeim As String)
With outgoingData
Call .WriteByte(ClientPacketID.AReto)
Call .WriteASCIIString(UserNeim)
End With
End Sub[/codigo]
Les quedarìa el siguiente comando:
/RETAR "NICK" + "ORO"
/ACEPTAR "NICK"
Espero que les haya servido...
Aclaro: No fue copy and paste
Fuente: Gs-Zone
