Sistema de subastas

TODO EN EL SERVIDOR..

Empecemos:

Abrimos el frmMain creamos un Timer con las siguientes caracteristicas:

Nombre: SubastaTIMER
Intervalo: 1500
Enabled = False


Le hacemos Doble CLICK y le ponemos lo siguiente:

Dim LagaHubOfertaB
LagaHubOfertaB = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Ofertaron")
If LagaHubOfertaB = 0 Then
'Call SendData(SendTarget.ToAll, 0, 0, "||Si nadie hace una oferta, la subasta se cierra en " & frmMain.SubastaLabel.Caption & " Segundos." & FONTTYPE_INFO)

If frmMain.SubastaLabel > 0 Then
'If frmMain.SubastaLabel = 240 Then
'Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 4 minutos." & FONTTYPE_SUBASTA)
'ElseIf frmMain.SubastaLabel = 180 Then
'Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 3 minutos." & FONTTYPE_SUBASTA)
If frmMain.SubastaLabel = 120 Then
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 2 minutos." & FONTTYPE_SUBASTA)
ElseIf frmMain.SubastaLabel = 60 Then
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 1 minuto." & FONTTYPE_SUBASTA)
End If
frmMain.SubastaLabel = frmMain.SubastaLabel - 1
Else
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta se a cerrado, disculpen las molestias." & FONTTYPE_SUBASTA)
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "0")
frmMain.SubastaTIMER.Enabled = False
End If

Else

Dim LagaNombreA As String
LagaNombreA = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Comprador")
Dim LagaNombreB As String
LagaNombreB = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Vendedor")

Dim LagaCompradorB As String
LagaCompradorB = NameIndex(LagaNombreA)
Dim LagaVendedorB As String
LagaVendedorB = NameIndex(LagaNombreB)

Dim LagaValorFinalB As String
LagaValorFinalB = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Valor")

If frmMain.SubastaLabel > 0 Then
If frmMain.SubastaLabel = 240 Then
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 4 minutos." & FONTTYPE_SUBASTA)
'ElseIf frmMain.SubastaLabel = 180 Then
'Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 3 minutos." & FONTTYPE_SUBASTA)
ElseIf frmMain.SubastaLabel = 120 Then
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 2 minutos." & FONTTYPE_SUBASTA)
ElseIf frmMain.SubastaLabel = 60 Then
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta terminara en 1 minuto." & FONTTYPE_SUBASTA)
End If
frmMain.SubastaLabel = frmMain.SubastaLabel - 1
Else

If EstaConectado(LagaVendedorB) And EstaConectado(LagaCompradorB) Then
If TieneObjetos(LagaObj.ObjIndex, LagaObj.Amount, LagaVendedorB) Then
If TieneOro(LagaCompradorB, LagaValorFinalB) Then

'Call SendData(SendTarget.ToAll, 0, 0, "||Se esta transferiendo el item y el oro." & FONTTYPE_SUBASTA)
Call PasarItemsyOro(LagaCompradorB, LagaVendedorB, LagaValorFinalB)

Else
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta se a cancelado debido a que el usuario " & LagaNombreA & " ya no posee las " & LagaValorFinalB & " Monedas de oro acordadas para esta venta." & FONTTYPE_SUBASTA)
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "0")
frmMain.SubastaTIMER.Enabled = False
Exit Sub
End If

Else
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta se a cancelado debido a que el usuario " & LagaNombreB & " ya no posee los Items acordados para esta venta." & FONTTYPE_SUBASTA)
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "0")
frmMain.SubastaTIMER.Enabled = False
Exit Sub
End If

Else
Call SendData(SendTarget.ToAll, 0, 0, "||La subasta se a cancelado debido a el o los usuarios que acordaron la venta se han desconectado." & FONTTYPE_SUBASTA)
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "0")
frmMain.SubastaTIMER.Enabled = False
Exit Sub
End If


Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "0")
frmMain.SubastaTIMER.Enabled = False


End If

End If
End Sub


Ahora creamos un nuevo modulo y le ponemos de nombre " SUBASTAS " y en el ponemos el siguiente codigo:

Function EstaConectado(ByVal User As Integer) As Boolean

If UserList(User).ConnID <> -1 And UserList(User).flags.UserLogged Then
EstaConectado = True
Exit Function
End If

EstaConectado = False
End Function

Function TieneOro(ByVal User As Integer, ByVal oro As Long) As Boolean

If UserList(User).Stats.GLD >= oro Then
TieneOro = True
Exit Function
End If

TieneOro = False
End Function

Sub PasarItemsyOro(ByVal Comprador As Integer, ByVal Vendedor As Integer, ByVal oro As Long)

Dim LagaObjB As Obj
LagaObjB.ObjIndex = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Objeto")
LagaObjB.Amount = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Cantidad")

UserList(Comprador).Stats.GLD = UserList(Comprador).Stats.GLD - oro
UserList(Vendedor).Stats.GLD = UserList(Vendedor).Stats.GLD + oro
Call MeterItemEnInventario(Comprador, LagaObjB)
Call QuitarObjetos(LagaObjB.ObjIndex, LagaObjB.Amount, Vendedor)
Call SendData(SendTarget.ToAll, 0, 0, "||El usuario " & UserList(Comprador).Name & " a comprado " & LagaObjB.Amount & " " & ObjData(LagaObjB.ObjIndex).Name & " a " & oro & " Monedas de oro!!!" & FONTTYPE_SUBASTA)
Call SendUserStatsBox(Comprador)
Call SendUserStatsBox(Vendedor)
Call UpdateUserInv(True, Vendedor, 0)
Exit Sub

End Sub


Luego donde termina el Case "/boveda" debajo ponemos :

Case "/INFOSUBASTA"
Dim LagaSubActivaC
LagaSubActivaC = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa")
If LagaSubActivaC = 0 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No hay ninguna subasta activa!." & FONTTYPE_INFO)
Exit Sub
End If
Dim LagaPrecioC
Dim LagaObjC As Obj
Dim LagaCompradorC
Dim LagaVendedorC
LagaObjC.ObjIndex = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Objeto")
LagaObjC.Amount = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Cantidad")
LagaPrecioC = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Valor")
LagaVendedorC = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Vendedor")
LagaCompradorC = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Comprador")
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||" & LagaVendedorC & " esta vendiendo " & LagaObj.Amount & " " & ObjData(LagaObj.ObjIndex).Name & "" & FONTTYPE_SUBASTA)
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Hasta ahora " & LagaCompradorC & " lidera la subasta ofertando " & LagaPrecioC & " Monedas de oro" & FONTTYPE_SUBASTA)
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Para ofertar escribe /Cantidad." & FONTTYPE_SUBASTA)
Exit Sub
Case "/CERRARSUBASTA"
If UserList(UserIndex).flags.Privilegios < 2 Then
If Not UserList(UserIndex).Name = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Vendedor") Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No puedes cerrar la subasta si no eres el creador de la misma." & FONTTYPE_SUBASTA)
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||La subasta se a cerrado debido a la descicion de su creador." & FONTTYPE_SUBASTA)
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "0")
frmMain.SubastaTIMER.Enabled = False
End If
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||La subasta se a cerrado debido a la descicion de " & UserList(UserIndex).Name & "." & FONTTYPE_SUBASTA)
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "0")
frmMain.SubastaTIMER.Enabled = False
End If
Exit Sub


Ahora en el fmrMain del SERVIDOR agregamos 3 labels:

Al primero lo llamamos: "SubastaActivada" con caption "1"

Alsegundo lo llamamos: "SubastaLabel" con caption "180"

Al tercero lo llamamos: "SubastaLabel2" con caption "180"

Luego...Abajo De:

If UCase$(Left$(rdata, 6)) = "/PMSG " Then
Call mdParty.BroadCastParty(UserIndex, Mid$(rdata, 7))
Exit Sub
End If


Ponemos:

'Subastar
If UCase$(Left$(rdata, 10)) = "/SUBASTAR " Then
rdata = Right$(rdata, Len(rdata) - 10)

If Not UserList(UserIndex).Stats.UserSkills(Comerciar) >= 50 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Nesesitas almenos 50 puntos en comercio para poder subastar." & FONTTYPE_INFO)
Exit Sub
End If

If frmMain.subastaActivada.Caption = 0 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Los gms han desactivado el sistema de subastas, porfavor espera un rato y vuelve a intentar." & FONTTYPE_INFO)
Exit Sub
End If

If UserList(UserIndex).Stats.ELV < 15 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Nesesitas nivel 15 para organizar una subasta." & FONTTYPE_INFO)
Exit Sub
End If

'Gracias gs por la ayuda con algunos parametros.
' [GS]
If InStr(rdata, "@") = False Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Debes usar @ para separar los terminos." & FONTTYPE_INFO)
Exit Sub
End If
If Numeric(ReadField(1, rdata, Asc("@"))) = False Or Numeric(ReadField(2, rdata, Asc("@"))) = False Or Numeric(ReadField(3, rdata, Asc("@"))) = False Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Uno de tus parametros no es numericos." & FONTTYPE_INFO)
Exit Sub
End If
If ReadField(1, rdata, Asc("@")) < 1 Or ReadField(1, rdata, Asc("@")) > 20 Or ReadField(2, rdata, Asc("@")) < 1 Or ReadField(2, rdata, Asc("@")) > 10000 Or ReadField(3, rdata, Asc("@")) < 1 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Uno de tus parametros es invalido." & FONTTYPE_INFO)
Exit Sub
End If
' [/GS]


Dim LagaIndex
LagaIndex = ReadField(1, rdata, Asc("@")) ' SLOT

If UserList(UserIndex).Invent.Object(LagaIndex).Amount > 0 Then
LagaObj.ObjIndex = UserList(UserIndex).Invent.Object(LagaIndex).ObjIndex
Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No hay ningun item en ese slot!." & FONTTYPE_INFO)
Exit Sub
End If

If UserList(UserIndex).Invent.Object(LagaIndex).Equipped > 0 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No puedes subastar ese item porque lo estas usando!." & FONTTYPE_INFO)
Exit Sub
End If

LagaObj.Amount = ReadField(2, rdata, Asc("@")) ' CANTIDAD

Dim LagaInicial
LagaInicial = ReadField(3, rdata, Asc("@")) ' VALOR INICIAL


'If (Not IsNumeric(ReadField(1, rdata, Asc("@")))) Or LagaObj.Amount = "" Or LagaInicial = "" Then
' Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Utilice /Subastar Slot@Cantidad@Precio" & FONTTYPE_INFO)
' Exit Sub
' End If

Dim LagaSubActivaA
LagaSubActivaA = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa")

If LagaSubActivaA = 1 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Ya hay una subasta activa en estos momentos!." & FONTTYPE_INFO)
Exit Sub
End If

If Not ObjData(LagaObj.ObjIndex).Subastable = 1 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Este objeto no puede ser subastado!." & FONTTYPE_INFO)
Exit Sub
End If
If Not TieneObjetos(LagaObj.ObjIndex, LagaObj.Amount, UserIndex) Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No posees el objeto o la cantidad que deseas subastar." & FONTTYPE_INFO)
Exit Sub
End If

Dim LagaNombre
LagaNombre = ObjData(LagaObj.ObjIndex).Name

frmMain.SubastaLabel2 = 180
frmMain.SubastaLabel = 180

Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa", "1")
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Ofertaron", "0")
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Valor", "" & LagaInicial & "")
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Vendedor", "" & UserList(UserIndex).Name & "")
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Comprador", "0")
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Objeto", "" & LagaObj.ObjIndex & "")
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Cantidad", "" & LagaObj.Amount & "")

Call SendData(SendTarget.ToAll, 0, 0, "||" & UserList(UserIndex).Name & " esta subastando " & LagaObj.Amount & " " & LagaNombre & " con un valor inicial de " & LagaInicial & " monedas de oro, Para participar escribe /Ofertar Cantidad, les recuerdo que solamente tienen 5 minuto para ofertar." & FONTTYPE_SUBASTA)
frmMain.SubastaTIMER.Enabled = True

Exit Sub
End If

If UCase$(Left$(rdata, 9)) = "/OFERTAR " Then
Dim LagaOro As Long
LagaOro = Right$(rdata, Len(rdata) - 9)

Dim LagaSubActiva
LagaSubActiva = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Activa")
Dim LagaValorFinalXI As Long
LagaValorFinalXI = GetVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Valor")

If UserList(UserIndex).Stats.ELV < 15 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Nesesitas almenos tener nivel 15 para poder participar en una subasta." & FONTTYPE_INFO)
Exit Sub
End If

If Not UserList(UserIndex).Stats.UserSkills(Comerciar) >= 20 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Nesesitas tener almenos 20 puntos en comercio para poder participar en una subasta." & FONTTYPE_INFO)
Exit Sub
End If

If LagaSubActiva = 0 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No hay ninguna subasta activa!." & FONTTYPE_INFO)
Exit Sub
End If

If LagaOro > UserList(UserIndex).Stats.GLD Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||No posees esa cantidad de oro." & FONTTYPE_INFO)
Exit Sub
End If

If Not LagaOro > LagaValorFinalXI + 499 Then
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Debe haber almenos una diferencia de 500 monedas a la ultima oferta!." & FONTTYPE_INFO)
Exit Sub
End If

If LagaOro > LagaValorFinalXI Then


LagaValorFinalXI = LagaOro
Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Valor", "" & LagaValorFinalXI & "")

Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Comprador", "" & UserList(UserIndex).Name & "")

Call SendData(SendTarget.ToAll, 0, 0, "||" & UserList(UserIndex).Name & " a superado la oferta anterior ofreciendo " & LagaValorFinalXI & " Monedas de oro, Para participar escribe /Ofertar Cantidad." & FONTTYPE_SUBASTA)

Call WriteVar(App.Path & "Dat" & "Subasta.ini", "Subasta", "Ofertaron", "1")

Else
Call SendData(SendTarget.ToIndex, UserIndex, 0, "||Losiento, ya hay una oferta mayor o igual a la tuya." & FONTTYPE_INFO)
Exit Sub
End If

Exit Sub
End If


Buscamos..

Public Const FONTTYPE_SERVER = "~0~185~0~0~0"


Ponemos:

Public Const FONTTYPE_SUBASTA = "~255~255~0~1~1"


Vamos a modulo Declaraciones y ponemos:

Public LagaObj as obj


y luego vamos al sub LoadObjData y abajo de :

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


Ponemos..

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



Vamos de nuevo al modulo Declaraciones y buscamos:

Newbie As Integer


Abajo Ponemos:

Subastable As Integer


Lo ultimo q hay q hacer es, abrir un bloc de notas y pegar lo siguiente dentro:


[Subasta]
Activa=0
Ofertaron=0
Valor=0
Vendedor=0
Comprador=0
Objeto=0
Cantidad=0


Y lo guardamos en la carpeta Dats del servidor con el nombre Subasta.ini

Comandos de la subasta:

Para subastar se hace /Subastar SLOT@CANTIDAD@PRECIO

Para ofertar /Ofertar CANTIDAD

Para ver informacion /Infosubasta

Para cerrar la subasta /CerrarSubasta