Venta/compra de personajes

Option Explicit

'TODO PUBLICO PARA UN FUTURO SISTEMA DE CAMBIOS Y PARA LOS PAQUETES :D

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

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

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