Lagalot
Newbie Lvl 6
Este codigo lo postee en el foro alkon con El user "ThunderBolt".
Subastas
Este codigo lo cree yo para mi server blizzardao, y hoy lo comparto con uds para que puedan mejorar sus servidores, y comprender mas algunas funciones del visual basic.
Como funciona? Yo lo que hice fue medio raro, para no complicarme las cosas cree un modulo aparte y un ini donde se guarde la informacion de vendedores y compradores.
En el servidor
En el frmmain creamos un timer de nombre:
con un intervalo de
de codigo le ponemos:
Esto lo que hace es leer el comprador, el vendedor, el item, el precio y la cantidad de oro acordada de un archivo de texto, y despues revisar si se poseen todavia los objetos acordados, tambien avisar en cuanto tiempo terminara la subasta.
Creamos un nuevo modulo, y en el pondremos las siguientes funciones que son IMPORTANTES para que la transaccion se lleve a cabo.
Estas funciones revisan si se posee el oro, si los usuarios estan conectados y tambien producen es traslado de los items y el oro.
Luego cuando termina el
ponemos esto:
Esto lo que hace es cerrar la subasta si sos el dueño, o brindar informacion de la misma a los posibles compradores.
Ahora hay que hacer lo siguente
1* Al SubastaTimer ponerle de propiedad
2* Crear un label "SubastaActivada" con caption
3* Crear un label "SubastaLabel" con caption
4* Crear un label "SubastaLabel2" con caption
5* Creamos un .ini que contenga esta informacion:
SIGUE ABAJO
Subastas
Este codigo lo cree yo para mi server blizzardao, y hoy lo comparto con uds para que puedan mejorar sus servidores, y comprender mas algunas funciones del visual basic.
Como funciona? Yo lo que hice fue medio raro, para no complicarme las cosas cree un modulo aparte y un ini donde se guarde la informacion de vendedores y compradores.
En el servidor
En el frmmain creamos un timer de nombre:
Código:
SubastaTIMER
Código:
1500
Código:
Dim LagaHubOfertaB
LagaHubOfertaB = GetVar(App.Path & "\Dat\" & "Subasta.ini", "Subasta", "Ofertaron")
If LagaHubOfertaB = 0 Then
'Call SendData(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(ToAll, 0, 0, "||La subasta terminara en 4 minutos." & FONTTYPE_SUBASTA)
'ElseIf frmMain.SubastaLabel = 180 Then
'Call SendData(ToAll, 0, 0, "||La subasta terminara en 3 minutos." & FONTTYPE_SUBASTA)
If frmMain.SubastaLabel = 120 Then
Call SendData(ToAll, 0, 0, "||La subasta terminara en 2 minutos." & FONTTYPE_SUBASTA)
ElseIf frmMain.SubastaLabel = 60 Then
Call SendData(ToAll, 0, 0, "||La subasta terminara en 1 minuto." & FONTTYPE_SUBASTA)
End If
frmMain.SubastaLabel = frmMain.SubastaLabel - 1
Else
Call SendData(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
LagaNombreA = GetVar(App.Path & "\Dat\" & "Subasta.ini", "Subasta", "Comprador")
Dim LagaNombreB
LagaNombreB = GetVar(App.Path & "\Dat\" & "Subasta.ini", "Subasta", "Vendedor")
Dim LagaCompradorB
LagaCompradorB = NameIndex(LagaNombreA)
Dim LagaVendedorB
LagaVendedorB = NameIndex(LagaNombreB)
Dim LagaValorFinalB
LagaValorFinalB = GetVar(App.Path & "\Dat\" & "Subasta.ini", "Subasta", "Valor")
If frmMain.SubastaLabel > 0 Then
If frmMain.SubastaLabel = 240 Then
Call SendData(ToAll, 0, 0, "||La subasta terminara en 4 minutos." & FONTTYPE_SUBASTA)
'ElseIf frmMain.SubastaLabel = 180 Then
'Call SendData(ToAll, 0, 0, "||La subasta terminara en 3 minutos." & FONTTYPE_SUBASTA)
ElseIf frmMain.SubastaLabel = 120 Then
Call SendData(ToAll, 0, 0, "||La subasta terminara en 2 minutos." & FONTTYPE_SUBASTA)
ElseIf frmMain.SubastaLabel = 60 Then
Call SendData(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(ToAll, 0, 0, "||Se esta transferiendo el item y el oro." & FONTTYPE_SUBASTA)
Call PasarItemsyOro(LagaCompradorB, LagaVendedorB, LagaValorFinalB)
Else
Call SendData(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(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(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
Esto lo que hace es leer el comprador, el vendedor, el item, el precio y la cantidad de oro acordada de un archivo de texto, y despues revisar si se poseen todavia los objetos acordados, tambien avisar en cuanto tiempo terminara la subasta.
Creamos un nuevo modulo, y en el pondremos las siguientes funciones que son IMPORTANTES para que la transaccion se lleve a cabo.
Código:
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(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
Estas funciones revisan si se posee el oro, si los usuarios estan conectados y tambien producen es traslado de los items y el oro.
Luego cuando termina el
Código:
Case "Boveda"
Código:
Case "/INFOSUBASTA"
Dim LagaSubActivaC
LagaSubActivaC = GetVar(App.Path & "\Dat\" & "Subasta.ini", "Subasta", "Activa")
If LagaSubActivaC = 0 Then
Call SendData(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(ToIndex, UserIndex, 0, "||" & LagaVendedorC & " esta vendiendo " & LagaObj.Amount & " " & ObjData(LagaObj.ObjIndex).Name & "" & FONTTYPE_SUBASTA)
Call SendData(ToIndex, UserIndex, 0, "||Hasta ahora " & LagaCompradorC & " lidera la subasta ofertando " & LagaPrecioC & " Monedas de oro" & FONTTYPE_SUBASTA)
Call SendData(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(ToIndex, UserIndex, 0, "||No puedes cerrar la subasta si no eres el creador de la misma." & FONTTYPE_SUBASTA)
Else
Call SendData(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(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
Esto lo que hace es cerrar la subasta si sos el dueño, o brindar informacion de la misma a los posibles compradores.
Ahora hay que hacer lo siguente
1* Al SubastaTimer ponerle de propiedad
Código:
Enabled = False
Código:
1
Código:
180
Código:
180
Código:
[Subasta]
Activa=0
Ofertaron=0
Valor=0
Vendedor=0
Comprador=0
Objeto=0
Cantidad=0
SIGUE ABAJO