Compra/Venta de personajes.

Ir abajo

Compra/Venta de personajes.

Mensaje por Toyz el 16/12/2016, 3:18 am

Dejo el módulo, los paquetes son un pocos complicados así que deberán saber mucho sobre el protocolo binario.

Módulo:
Código:
Option Explicit

Private Const Max_Ventas As Byte = 50 'Cantidad máxima de usuarios a la venta

Private Type tVentas
    Precio As Long
    Dato As tDatos
    Recibe As String
End Type

Public Ventas(1 To Max_Ventas) As tVentas

Public Sub Carga_Ventas()
   
    Dim LoopC As Long
    Dim loopX As Long
    Dim LoopZ As Long
    Dim LoopI As Long
    Dim LoopA As Long
    Dim LoopO As Long
   
    Dim Leer As clsIniReader
   
    Set Leer = New clsIniReader
    Call Leer.Initialize(App.Path & "\Dat\Ventas.dat")
   
    For LoopC = 1 To Max_Ventas
        With Ventas(LoopC)
            With Ventas(LoopC).Dato
                .Candado = CByte(Leer.GetValue("VENTA#" & LoopC, "Candado"))
                .clase = CByte(Leer.GetValue("VENTA#" & LoopC, "Clase"))
                .Mana = CInt(Leer.GetValue("VENTA#" & LoopC, "Mana"))
                .Vida = CInt(Leer.GetValue("VENTA#" & LoopC, "Vida"))
                .Nivel = CByte(Leer.GetValue("VENTA#" & LoopC, "Nivel"))
                .raza = CByte(Leer.GetValue("VENTA#" & LoopC, "Raza"))
                .Nombre = Leer.GetValue("VENTA#" & LoopC, "Nombre")
                .Porcentaje = CDbl(Leer.GetValue("VENTA#" & LoopC, "Porcentaje"))
                .Privado = Leer.GetValue("VENTA#" & LoopC, "Privado")
                .Oro = CLng(Leer.GetValue("VENTA#" & LoopC, "Oro_Inventario"))
                .Status = CByte(Leer.GetValue("VENTA#" & LoopC, "Status"))
               
                For loopX = 1 To MAXUSERHECHIZOS
                    .Hechizos(loopX) = CInt(Leer.GetValue("VENTA#" & LoopC, "Hechizo#" & loopX))
                Next loopX
               
                For LoopZ = 1 To MAX_NORMAL_INVENTORY_SLOTS
                    .Objetos(LoopZ).ObjIndex = CInt(ReadField(1, Leer.GetValue("VENTA#" & LoopC, "Objeto#" & LoopZ), 45))
                    .Objetos(LoopZ).Amount = CInt(ReadField(2, (Leer.GetValue("VENTA#" & LoopC, "Objeto#" & LoopZ)), 45))
                Next LoopZ
               
                For LoopI = 1 To NUMSKILLS
                    .Skills(LoopI) = CByte(Leer.GetValue("VENTA#" & LoopC, "Skill#" & LoopI))
                Next LoopI
               
                For LoopA = 1 To MAX_BANCOINVENTORY_SLOTS
                    .Boveda.Objetos(LoopA).ObjIndex = CInt(ReadField(1, (Leer.GetValue("VENTA#" & LoopC, "OBJETO_BOVEDA#" & LoopZ)), 45))
                    .Boveda.Objetos(LoopA).Amount = CInt(ReadField(2, (Leer.GetValue("VENTA#" & LoopC, "OBJETO_BOVEDA#" & LoopZ)), 45))
                Next LoopA
               
                For LoopO = 1 To NUMATRIBUTOS
                    .Atributos(LoopO) = CByte(Leer.GetValue("VENTA#" & LoopC, "Atributo#" & LoopO))
                Next LoopO
            End With
            .Dato.Boveda.Oro = CLng(Leer.GetValue("VENTA#" & LoopC, "Oro_Boveda"))
            .Precio = CLng(Leer.GetValue("VENTA#" & LoopC, "Precio"))
            .Recibe = Leer.GetValue("VENTA#" & LoopC, "Recibe")
        End With
    Next LoopC
End Sub

Public Sub Publicar_Personaje(ByVal ID As Integer, ByVal Precio As Long, ByVal Privado As String, ByVal Candado As Byte, ByVal PIN As String, ByVal Recibe As String)
   
    Dim Archivo As String
    Dim EnVenta As Byte
    Dim PIN_Leida As String
   
    Archivo = CharPath & UCase$(UserList(ID).name) & ".chr"
    PIN_Leida = GetVar(Archivo, "INIT", "PIN")
   
    If UCase$(PIN_Leida) <> UCase$(PIN) Then
        Call WriteConsoleMsg(ID, "PIN incorrecta.", FontTypeNames.FONTTYPE_GUILD)
        Exit Sub
    End If
   
    If Precio < 1 Then
        Call WriteConsoleMsg(ID, "El precio mínimo de una venta debe ser de 1 moneda.", FontTypeNames.FONTTYPE_GUILD)
        Exit Sub
    End If
   
    If Not FileExist(CharPath & UCase$(Recibe) & ".chr", vbNormal) Then
        Call WriteConsoleMsg(ID, "El personaje que especificaste en tu venta para que reciba el oro no existe.", FontTypeNames.FONTTYPE_GUILD)
        Exit Sub
    End If
   
    Call WriteConsoleMsg(ID, "Tu personaje fue puesto en venta.", FontTypeNames.FONTTYPE_GUILD)
   
    EnVenta = Dame_ID_Venta
   
    With Ventas(EnVenta)
        .Precio = Precio
        .Dato.Candado = Candado
        .Dato.Privado = Privado
        .Recibe = Recibe
    End With
   
    Call Setear_Venta(EnVenta, ID)
    Call Guardar_Venta(EnVenta)
   
    UserList(ID).flags.EnVenta = EnVenta

    If Ventas(EnVenta).Dato.Candado > 0 Then
        UserList(ID).flags.EnCandado = 1
        Call CloseSocket(ID)
    End If
End Sub

Public Sub Quitar_Persona(ByVal Venta_ID As Byte)

    Dim Archivo As String

    Dim ID As Integer
    With Ventas(Venta_ID)
        Archivo = CharPath & UCase$(Ventas(Venta_ID).Dato.Nombre) & ".chr"
        Erase .Dato.Atributos()
        Erase .Dato.Boveda.Objetos()
        Erase .Dato.Hechizos()
        Erase .Dato.Objetos()
        Erase .Dato.Skills()
        .Precio = 0
        .Dato.Candado = 0
        .Dato.clase = 0
        .Dato.Mana = 0
        .Dato.Nivel = 0
        .Dato.Nombre = vbNullString
        .Dato.Oro = 0
        .Dato.Porcentaje = 0
        .Dato.Privado = 0
        .Dato.raza = 0
        .Dato.Vida = 0
        .Dato.Boveda.Oro = 0
        .Recibe = vbNullString
        Guardar_Venta (Venta_ID)
        WriteVar Archivo, "FLAGS", "EnCandado", 0
        WriteVar Archivo, "FLAGS", "EnVenta", 0
    End With
   
End Sub

Public Sub Guardar_Venta(ByVal ID_Venta As Byte)

    Dim LoopC As Long
    Dim loopX As Long
    Dim LoopZ As Long
    Dim LoopI As Long
    Dim LoopA As Long
    Dim Archivo As String
    Archivo = App.Path & "\Dat\Ventas.dat"

    With Ventas(ID_Venta).Dato
   
        For LoopC = 1 To MAXUSERHECHIZOS
            Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Hechizo#" & LoopC, CStr(.Hechizos(LoopC)))
        Next LoopC

        For loopX = 1 To MAX_NORMAL_INVENTORY_SLOTS
            Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Objeto#" & loopX, CStr(.Objetos(loopX).ObjIndex) & "-" & CStr(.Objetos(loopX).Amount))
        Next loopX

        For LoopZ = 1 To NUMSKILLS
            Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Skill#" & LoopZ, CStr(.Skills(LoopZ)))
        Next LoopZ

        For LoopI = 1 To NUMATRIBUTOS
            Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Atributo#" & LoopI, CStr(.Atributos(LoopI)))
        Next LoopI

        For LoopA = 1 To MAX_BANCOINVENTORY_SLOTS
            Call WriteVar(Archivo, "VENTA#" & ID_Venta, "OBJETO_BOVEDA#" & LoopA, CStr(.Boveda.Objetos(LoopA).ObjIndex) & "-" & CStr(.Boveda.Objetos(LoopA).Amount))
        Next LoopA

        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Precio", CStr(Ventas(ID_Venta).Precio))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Candado", CStr(Ventas(ID_Venta).Dato.Status))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Privado", Ventas(ID_Venta).Dato.Privado)
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Status", CStr(Ventas(ID_Venta).Dato.Status))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Recibe", Ventas(ID_Venta).Recibe)
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Vida", CStr(.Vida))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Mana", CStr(.Mana))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Clase", CStr(.clase))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Nivel", CStr(.Nivel))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Nombre", .Nombre)
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Oro_Inventario", CStr(.Oro))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Oro_Boveda", CStr(.Boveda.Oro))
        Call WriteVar(Archivo, "VENTA#" & ID_Venta, "Porcentaje", CStr(.Porcentaje))

    End With
End Sub

Public Sub Setear_Venta(ByVal ID_Venta, ByVal ID As Integer)

    Dim LoopC As Long
    Dim loopX As Long
    Dim LoopZ As Long
    Dim LoopI As Long
    Dim LoopA As Long

    With Ventas(ID_Venta).Dato
        .Vida = UserList(ID).Stats.MaxHp
        .Mana = UserList(ID).Stats.MaxMAN
        .clase = UserList(ID).clase
        .Nivel = UserList(ID).Stats.ELV
        .Nombre = UserList(ID).name
        .Oro = UserList(ID).Stats.GLD
        .Porcentaje = FormatNumber(Porcentaje(UserList(ID).Stats.ELU, UserList(ID).Stats.Exp), 2)
        .Boveda.Oro = UserList(ID).Stats.Banco
        .Status = IIf(UserList(ID).Reputacion.Promedio > 0, 1, 2)
   
        For LoopC = 1 To MAXUSERHECHIZOS
            .Hechizos(LoopC) = UserList(ID).Stats.UserHechizos(LoopC)
        Next LoopC

        For loopX = 1 To MAX_NORMAL_INVENTORY_SLOTS
            .Objetos(loopX).ObjIndex = UserList(ID).Invent.Object(loopX).ObjIndex
            .Objetos(loopX).Amount = UserList(ID).Invent.Object(loopX).Amount
        Next loopX

        For LoopZ = 1 To NUMSKILLS
            .Skills(LoopZ) = UserList(ID).Stats.UserSkills(LoopZ)
        Next LoopZ

        For LoopI = 1 To NUMATRIBUTOS
            .Atributos(LoopI) = UserList(ID).Stats.UserAtributos(LoopI)
        Next LoopI

        For LoopA = 1 To MAX_BANCOINVENTORY_SLOTS
            .Boveda.Objetos(LoopA) = UserList(ID).BancoInvent.Object(LoopA)
        Next LoopA
    End With
End Sub

Public Sub Comprar_Personaje(ByVal ID As Integer, ByVal ID_Venta As Byte, ByVal Privado As String, ByVal Nombre As String)
   
    Dim Archivo As String
    Dim PIN As String
    Dim Pass As String
    Dim email As String
    Dim ID_Comprado As Integer
    Dim Oro_Leido As Long
   
    With Ventas(ID_Venta)
       
        If UCase$(UserList(ID).name) = UCase$(Nombre) Then
            Call WriteConsoleMsg(ID, "No puedes comprar tu mismo personaje", FontTypeNames.FONTTYPE_GUILD)
            Exit Sub
        End If
       
        If UCase$(UserList(ID).name) = UCase$(.Recibe) Then
            Call WriteConsoleMsg(ID, "No puedes comprar tu mismo personaje", FontTypeNames.FONTTYPE_GUILD)
            Exit Sub
        End If
       
        If UCase$(Nombre) <> UCase$(.Dato.Nombre) Then
            Call WriteConsoleMsg(ID, "El personaje que deseas comprar ya no está a la venta.", FontTypeNames.FONTTYPE_GUILD)
            Exit Sub
        End If
   
        If UserList(ID).Stats.GLD < .Precio Then
            Call WriteConsoleMsg(ID, "No tienes la cantidad de oro para comprar este personaje.", FontTypeNames.FONTTYPE_GUILD)
            Exit Sub
        End If
       
        If Len(.Dato.Privado) > 0 Then
            If Not UCase$(Privado) = UCase$(.Dato.Privado) Then
                Call WriteConsoleMsg(ID, "Contraseña de la venta incorrecta.", FontTypeNames.FONTTYPE_GUILD)
                Exit Sub
            End If
        End If
       
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD - .Precio
       
        If NameIndex(.Dato.Nombre) > 0 Then
            Call CloseSocket(NameIndex(.Dato.Nombre))
        End If
       
        Archivo = CharPath & UCase$(UserList(ID).name) & ".chr"
        PIN = GetVar(Archivo, "INIT", "PIN")
        Pass = GetVar(Archivo, "INIT", "Password")
        email = GetVar(Archivo, "CONTACTO", "Email")
       
        Archivo = CharPath & UCase$(.Dato.Nombre) & ".chr"
        WriteVar Archivo, "INIT", "PIN", PIN
        WriteVar Archivo, "INIT", "Password", Pass
        WriteVar Archivo, "CONTACTO", "Email", email
       
        ID_Comprado = NameIndex(.Recibe)
       
        If ID_Comprado > 0 Then
            Call WriteConsoleMsg(ID_Comprado, "Tu personaje " & .Dato.Nombre & " fue comprado satisfactoriamente por " & .Precio & " monedas de oro, el oro ya está en la bóveda de este personaje. Felicidades.", FontTypeNames.FONTTYPE_GUILD)
            UserList(ID_Comprado).Stats.Banco = UserList(ID_Comprado).Stats.Banco + .Precio
            Call WriteUpdateBankGold(ID_Comprado)
        Else
            Archivo = CharPath & UCase$(.Recibe) & ".chr"
            Oro_Leido = GetVar(Archivo, "STATS", "GLD")
            Oro_Leido = Oro_Leido + .Precio
            WriteVar Archivo, "STATS", "GLD", Oro_Leido
        End If
       
        Call Quitar_Persona(ID_Venta)
        Call WriteConsoleMsg(ID, "Personaje comprado satisfactoriamente, los datos del personaje comprado ahora son los de tu personaje", FontTypeNames.FONTTYPE_GUILD)
        Call WriteUpdateGold(ID)
    End With
End Sub

Private Function Dame_ID_Venta() As Byte
    Dim LoopC As Long
    For LoopC = 1 To Max_Ventas
        With Ventas(LoopC)
            If .Precio = 0 Then
                Dame_ID_Venta = LoopC
                Exit Function
            End If
        End With
    Next LoopC
End Function

Public Sub Quitar_Personaje(ByVal ID As Integer, ByVal ID_Venta As Byte, ByVal PIN As String)

    With Ventas(ID_Venta)
   
        Dim Archivo As String
        Dim PIN_Leida As String
   
        Archivo = CharPath & UCase$(.Dato.Nombre) & ".chr"
        PIN_Leida = GetVar(Archivo, "INIT", "PIN")
       
        If UCase$(PIN) <> UCase$(PIN_Leida) Then
            Call WriteConsoleMsg(ID, "PIN Incorrecta", FontTypeNames.FONTTYPE_GUILD)
            Exit Sub
        End If
       
        Call Quitar_Persona(ID_Venta)
        Call WriteConsoleMsg(ID, "Personaje quitado de la venta correctamente.", FontTypeNames.FONTTYPE_GUILD)
    End With
   
End Sub

Ayudas:
Código:
Public Type tBoveda
    Objetos(1 To MAX_BANCOINVENTORY_SLOTS) As UserObj
    Oro As Long
End Type

Public Type tDatos
    Status As Byte
    Nombre As String
    Vida As Integer
    Mana As Integer
    raza As Byte
    clase As Byte
    Nivel As Byte
    Porcentaje As Double
    Skills(1 To NUMSKILLS) As Byte
    Atributos(1 To NUMATRIBUTOS) As Byte
    Privado As String
    Candado As Byte
    Objetos(1 To MAX_NORMAL_INVENTORY_SLOTS) As Obj
    Hechizos(1 To MAXUSERHECHIZOS) As Integer
    Boveda As tBoveda
    Oro As Long
End Type

Esto no es un aporte para los que recién empiezan, deberán leer todo el código y entenderlo para poder hacer los paquetes de manera correcta.

Esto sirve muchísimo, te ahorra 1 o 2 horas de programar el sistema y hacer los paquetes llevará unos 20 minutos.

Si sabés bien qué es y cómo se maneja el protocolo binario es DEMASIADO fácil hacer los paquetes Razz

Foto de cómo queda:




Después hago un video.


_______________

Como saben yo aporto bastante en Servers-Argentum y les quiero decir que todos tienen derecho de usar y de aportar en otra comunidad mis aportes pero sólo con un requisito y es tan simple que dejar los créditos. Gracias.
Si conocen otra comunidad y en esa misma mis aportes no están aportados, si tenés tiempo y ganas, aportalo! A mucha gente le puede servir. No te olvides del requisito Razz

MIS MEJORES APORTES:

Compra/venta de personajes:
https://goo.gl/A44Av0

Juegos del Hambre:
https://goo.gl/u6aNUG

Deathmatch automático:
https://goo.gl/GQF4fK

Sistema de retos vía MMR con búsqueda, emparejamiento, etc:
https://goo.gl/40uP0f

Sistemas de eventos automáticos de 1vs1 hasta 10vs10:
https://goo.gl/XYKygc

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)
https://goo.gl/qq83wx

Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro]
https://goo.gl/x8SMnV

Eliminar sistema de Skill (COMPLETO)
https://goo.gl/mKxHzC
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5046
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Compra/Venta de personajes.

Mensaje por Metrosersuah el 16/12/2016, 3:34 am

Estaría bueno qué dejes el formulario así la gente se ahorra el tiempo de hacerlo.
Excelente aporte G Toyz.
avatar
Metrosersuah
Nivel 5
Nivel 5

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 234
Localización : 4 Paredes
Fecha de inscripción : 13/02/2016

Ver perfil de usuario http://www.argentumonline.com.ar

Volver arriba Ir abajo

Re: Compra/Venta de personajes.

Mensaje por Toyz el 16/12/2016, 3:36 am

El formulario me llevó hacerlo 5 minutos, no cuesta nada. La idea es que se esmeren aparte los formularios depende cómo hagan los paquetes porque yo hago llamadas a los paquetes que yo hice y eso podría generar confusión y errores.

Gracias.


_______________

Como saben yo aporto bastante en Servers-Argentum y les quiero decir que todos tienen derecho de usar y de aportar en otra comunidad mis aportes pero sólo con un requisito y es tan simple que dejar los créditos. Gracias.
Si conocen otra comunidad y en esa misma mis aportes no están aportados, si tenés tiempo y ganas, aportalo! A mucha gente le puede servir. No te olvides del requisito Razz

MIS MEJORES APORTES:

Compra/venta de personajes:
https://goo.gl/A44Av0

Juegos del Hambre:
https://goo.gl/u6aNUG

Deathmatch automático:
https://goo.gl/GQF4fK

Sistema de retos vía MMR con búsqueda, emparejamiento, etc:
https://goo.gl/40uP0f

Sistemas de eventos automáticos de 1vs1 hasta 10vs10:
https://goo.gl/XYKygc

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)
https://goo.gl/qq83wx

Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro]
https://goo.gl/x8SMnV

Eliminar sistema de Skill (COMPLETO)
https://goo.gl/mKxHzC
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5046
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Compra/Venta de personajes.

Mensaje por Metrosersuah el 16/12/2016, 3:42 am

@Toyz escribió:El formulario me llevó hacerlo 5 minutos, no cuesta nada. La idea es que se esmeren aparte los formularios depende cómo hagan los paquetes porque yo hago llamadas a los paquetes que yo hice y eso podría generar confusión y errores.

Gracias.

Claro, capas lo utilice por más que yo tengo uno, voy a tomarlo como base para hacerlo automatico gg.
avatar
Metrosersuah
Nivel 5
Nivel 5

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 234
Localización : 4 Paredes
Fecha de inscripción : 13/02/2016

Ver perfil de usuario http://www.argentumonline.com.ar

Volver arriba Ir abajo

Re: Compra/Venta de personajes.

Mensaje por Toyz el 16/12/2016, 3:44 am

Como aclaré en el thread, si saben cómo funciona y qué es el protocolo binario los paquetes los van hacer muy rápido. Lo demás son algunos que otros bucles y variables.

Espero que te sirva Razz

Aclaración:

Tendrán que hacer llamadas en el Sub Main (Servidor)
Hacer 2 flags.
Y chequeos en el SaveUser.


_______________

Como saben yo aporto bastante en Servers-Argentum y les quiero decir que todos tienen derecho de usar y de aportar en otra comunidad mis aportes pero sólo con un requisito y es tan simple que dejar los créditos. Gracias.
Si conocen otra comunidad y en esa misma mis aportes no están aportados, si tenés tiempo y ganas, aportalo! A mucha gente le puede servir. No te olvides del requisito Razz

MIS MEJORES APORTES:

Compra/venta de personajes:
https://goo.gl/A44Av0

Juegos del Hambre:
https://goo.gl/u6aNUG

Deathmatch automático:
https://goo.gl/GQF4fK

Sistema de retos vía MMR con búsqueda, emparejamiento, etc:
https://goo.gl/40uP0f

Sistemas de eventos automáticos de 1vs1 hasta 10vs10:
https://goo.gl/XYKygc

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)
https://goo.gl/qq83wx

Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro]
https://goo.gl/x8SMnV

Eliminar sistema de Skill (COMPLETO)
https://goo.gl/mKxHzC
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5046
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Compra/Venta de personajes.

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.