Sistema de canje + el comando /darpun

Server:

Buscamos:

Código:

SetIniVar              '/SETINIVAR LLAVE CLAVE VALOR

y abajo ponemos :

Código:

DARPUN                  '/DARPUN USUARIO@CANTIDAD

luego buscamos:

Código:

Case eGMCommands.SetIniVar              '/SETINIVAR LLAVE CLAVE VALOR
            Call HandleSetIniVar(UserIndex)

y abajo colocamos:

Código:

Case eGMCommands.DARPUN                  'DARPUN
            Call HandleDARPUN(UserIndex)

Buscamos:

Código:

'Estadisticas
Public Const STAT_MAXELV As Byte = 255

y arriba ponemos:

Código:

Public CantPremios As Integer

luego buscamos:

Código:

'Estadisticas de los usuarios

y arriba ponemos:



Public Type tPremios
puntos As Long
ObjIndex As Long
End Type



luego buscamos:



Public BanIps As New Collection



y abajo ponemos:



Public PremiosInfo() As tPremios



luego buscamos:



Upgrade As Integer



y arriba ponemos:


puntos As Integer



luego buscamos:




ExpSkills(1 To NUMSKILLS) As Long



y abajo ponemos:




puntos As integer



terminamos de declarar

ahora buscamos:



''&&&&&&&&&&&&&&&&&&&&& FIN BALANCE &&&&&&&&&&&&&&&&&&&&&&&
Call Statistics.Initialize



y abajo colocamos:




Dim i As integer
CantPremios = val(GetVar(DatPath & "Premios.dat", "INIT", "CantPremios"))
If CantPremios > 0 Then 'Evitamos el error
ReDim PremiosInfo(1 To CantPremios) As tPremios
For i = 1 To CantPremios
PremiosInfo(i).ObjIndex = val(GetVar(DatPath & "Premios.dat", "PREMIO" & i, "ObjIndex"))
PremiosInfo(i).puntos = val(GetVar(DatPath & "Premios.dat", "PREMIO" & i, "Puntos"))
Next i
End If



luego buscamos:




CancelOfferItem



y abajo ponemos:



Premios



luego buscamos:




Consultation



y abajo colocamos:




PidePremios
RPremios




luego buscamos:



Case ClientPacketID.Consultation
Call HandleConsultation(UserIndex)



y abajo ponemos:




Case ClientPacketID.PidePremios
Call HandlePremiosRequest(UserIndex)

Case ClientPacketID.RPremios
Call HandleRPremios(UserIndex)



luego en el protocol.bas abajo de todo ponemos:




Public Sub WritePremios(ByVal UserIndex As Integer)

If CantPremios = 0 Then Exit Sub

Dim i As Integer

With UserList(UserIndex).outgoingData
Call .WriteByte(ServerPacketID.Premios)
Call .WriteInteger(CantPremios)
Call .WriteLong(UserList(UserIndex).Stats.puntos)
End With

For i = 1 To CantPremios
With UserList(UserIndex).outgoingData
Call .WriteASCIIString(ObjData(PremiosInfo(i).ObjIndex).name)
Call .WriteInteger(PremiosInfo(i).puntos)
Call .WriteInteger(ObjData(PremiosInfo(i).ObjIndex).GrhIndex)
End With
Next i

End Sub
Public Sub HandlePremiosRequest(ByVal UserIndex As Integer)
UserList(UserIndex).incomingData.ReadByte

Call WritePremios(UserIndex)
End Sub



Public Sub HandleRPremios(ByVal UserIndex As Integer)

Dim Premio As Obj
Dim index As Integer


With UserList(UserIndex).incomingData
.ReadByte
index = .ReadInteger

End With

'Set the object
Premio.ObjIndex = PremiosInfo(index).ObjIndex
Premio.Amount = 1

If Premio.ObjIndex <= 0 Then Exit Sub


If PremiosInfo(index).puntos <= UserList(UserIndex).Stats.puntos Then
If Not MeterItemEnInventario(UserIndex, Premio) Then
Call WriteConsoleMsg(UserIndex, "No tienes espacio en el inventario.", FontTypeNames.FONTTYPE_INFO)
Else
UserList(UserIndex).Stats.puntos = UserList(UserIndex).Stats.puntos - PremiosInfo(index).puntos
Call UpdateUserInv(True, UserIndex, 0)
End If
Else
Call WriteConsoleMsg(UserIndex, "No tienes suficientes puntos.", FontTypeNames.FONTTYPE_INFO)
End If

End Sub

Private Sub HandleDARPUN(ByVal UserIndex As Integer)

If UserList(UserIndex).incomingData.length < 2 Then
Err.Raise UserList(UserIndex).incomingData.NotEnoughDataErrCode
Exit Sub
End If

On Error GoTo Errhandler
With UserList(UserIndex)
'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 UserName As String
Dim DARPUN As Long
Dim tUser As Integer

UserName = buffer.ReadASCIIString()
DARPUN = buffer.ReadLong()

If InStr(1, UserName, "+") Then
UserName = Replace(UserName, "+", " ")
End If

If .flags.Privilegios And (PlayerType.User Or PlayerType.Consejero Or PlayerType.SemiDios) Then Exit Sub


If LenB(UserName) = 0 Then
Call WriteConsoleMsg(UserIndex, "Comando Incorrecto. Utilice /darpun NICKNAME@PUNTOS.", FontTypeNames.FONTTYPE_INFO)
Else
tUser = NameIndex(UserName)
End If

If tUser <= 0 Then
Call WriteConsoleMsg(UserIndex, "El Usuario No Esta Online", FontTypeNames.FONTTYPE_INFO)
End If

If FileExist(CharPath & UserName & ".chr", vbNormal) Then
UserList(tUser).Stats.puntos = UserList(tUser).Stats.puntos + DARPUN
Call WriteConsoleMsg(tUser, "Los Dioses Te Han Regalado " & DARPUN & " Puntos De canje", FontTypeNames.FONTTYPE_INFO)
Call WriteConsoleMsg(UserIndex, "Le Has dado " & DARPUN & " puntos de canje a " & UserList(tUser).name, FontTypeNames.FONTTYPE_INFO)
Else
Call WriteConsoleMsg(UserIndex, "El Personaje no existe", FontTypeNames.FONTTYPE_INFO)
End If
'If we got here then packet is complete, copy data back to original queue
Call .incomingData.CopyBuffer(buffer)
End With

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



luego buscamos:



.NoSeCae = val(Leer.GetValue("OBJ" & Object, "NoSeCae"))



y abajo ponemos:



.puntos = val(Leer.GetValue("OBJ" & Object, "Puntos"))



luego buscamos:



.ELV = CByte(UserFile.GetValue("STATS", "ELV"))



y abajo colocamos:



.puntos = CByte(UserFile.GetValue("STATS", "Puntos"))



luego buscamos:



Call WriteVar(UserFile, "STATS", "BANCO", CStr(.Stats.Banco))



y abajo colocamos:



Call WriteVar(UserFile, "STATS", "PUNTOS", CStr(.Stats.puntos))



luego buscamos:



.Stats.GLD = 0



y abajo colocamos:



.Stats.puntos = 0



Bueno terminamos con el server...

Cliente:

buscamos:



'Objetos
Public Const MAX_INVENTORY_OBJS As Integer = 10000



y arriba ponemos:



Public PremiosInv(1 To 20) As PremiosList 'importante esto dice la cantidad de premios que hay ... si superan los 20 premios cambian el 20 por el numero de premios que tengan...



buscamos:



Public UserHogar As eCiudad



y abajo colocamos:



Public UserPuntos As integer



buscamos:



'Inventario
Type Inventory



y arriba ponemos:



Type PremiosList
Name As String
'GrhIndex As Integer
puntos As Integer
End Type



buscamos:



SetIniVar '/SETINIVAR LLAVE CLAVE VALOR



y abajo colocamos:


DARPUN '/DARPUN NOMBRE@CANTIDAD



luego buscamos:


buscamos:



UserNameList ' LISTUSU



y abajo colocamos:


Premios



luego buscamos:



Consulta



y abajo colocamos:


PidePremios
RPremios



luego buscamos:



Case ServerPacketID.UserNameList ' LISTUSU
Call HandleUserNameList



y abajo colocamos:



Case ServerPacketID.Premios ' CANJE
Call HandlePremios

Case ServerPacketID.ShowGuildAlign
Call HandleShowGuildAlign



al final del protocol.bas ponemos:

P

ublic Sub WriteRPremios(ByVal Index As Integer)
With outgoingData
Call .WriteByte(ClientPacketID.RPremios)
Call .WriteInteger(Index)
End With
End Sub

Public Sub PedirPremios()
Call outgoingData.WriteByte(ClientPacketID.PidePremios)
End Sub


Public Sub HandlePremios()

Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)

Dim CantPremios As Byte
Dim i As Byte

Call Buffer.ReadByte
CantPremios = Buffer.ReadInteger
UserPuntos = Buffer.ReadLong
For i = 1 To CantPremios
With PremiosInv(i)
.Name = Buffer.ReadASCIIString
.puntos = Buffer.ReadInteger
.GrhIndex = Buffer.ReadInteger
End With

If PremiosInv(i).Name <> "" Then
frmPremios.List1.AddItem PremiosInv(i).Name
Else
frmPremios.List1.AddItem "Nada"
End If
Next i

Call incomingData.CopyBuffer(Buffer)


End Sub

Public Sub WriteDARPUN(ByVal UserName As String, ByVal DAPUN As Long)
With outgoingData
Call .WriteByte(ClientPacketID.GMCommands)
Call .WriteByte(eGMCommands.DARPUN)
Call .WriteASCIIString(UserName)
Call .WriteLong(DAPUN)
End With
End Sub



luego buscamos:


Case "/MEDITAR"



y arriba ponemos:



Case "/DARPUN"
If notNullArguments Then
tmpArr = Split(ArgumentosRaw, "@")
If UBound(tmpArr) = 1 Then
Call WriteDARPUN(tmpArr(0), tmpArr(1))
Else
Call ShowConsoleMsg("Formato incorrecto. Utilice /darpun NICKNAME@PUNTOS.")
End If
Else
Call ShowConsoleMsg("Faltan parámetros. Utilice /darpun NICKNAME@PUNTOS.")
End If



luego crean un image o un button y adentro ponen:



frmPremios.Show , frmMain



por último se descargan estre formulario y lo ponen en el cliente :
FrmPremios : [Tienes que estar registrado y conectado para ver este vínculo]


ahora para los items de canje tienen que crear DENTRO de la carpeta DAT el archivo "Premios.DAT" y adentro colocan esto:

[INIT]
CantPremios=1' acá va la cantidad de premios en este caso para el ejemplo es 1

[PREMIO1]'siempre que pongan un item de canje colocan PREMIO y el numero del premio en este caso PREMIO1
ObjIndex=403' este es el número del objeto
Puntos=10' y este es la cantidad de puntos necesarios

Listorti!

Donde qieras donde te qede comodo

Spitfire escribió:Pero no dice, en init para configurar el premio, y eso no va en el cliente? influye eso?

El init lo lee el servidor.

Cood escribió:Muy interesante la verdad, es el sistema que lleva arkhantos, Es completamente funcional y excepcional al momento de eventos para dar puntos y cambiar tus premios, la verdad un muy lindo aporte!

Flashaste, eso no tiene arkhantos. El de arkhantos manda 1 byte solamente y está mucho más optimizado.

ajaja el de Arkhantos, como digo fran, esta mejor Optimizado, tene en cuenta que Francohhh sabe MUCHO DE PROGRAMACION y puede hacer qe un AO Pese 1mb (?

Y porque no esta trabajando en Tierras del s... Impe... Wow si sabe tanto?
Esta bueno el codigo.

Me tira error

no se encontro el metodo o miembro de datos

Código:

.GrhIndex = Buffer.ReadInteger

?

Edit: Lo solucioné pero cuando quiero loguear me dice: Connection was aborted for timout failure...