GS > Codigo para el server
Bueno, aqui les dejo el sistema de seguridad de pjs, que estuve haciendo:
Primero, vamos al TCP, y buscamos el Sub ConnectUser, la reemplazamos por lo siguiente:
Ahora en este mismo modulo, vamos abajo de todo, y ponemos lo siguiente:
Espero que les sirva de utilidad, cualquier BUG por favor reportenmelo.
Este sistema sera usado en el Ao-Ready y en el GSS :O
Original Idea By GS !
Bueno, aqui les dejo el sistema de seguridad de pjs, que estuve haciendo:
Primero, vamos al TCP, y buscamos el Sub ConnectUser, la reemplazamos por lo siguiente:
Código:
Sub ConnectUser(ByVal UserIndex As Integer, Name As String, Password As String)
Dim N As Integer
'Reseteamos los FLAGS
UserList(UserIndex).flags.Escondido = 0
UserList(UserIndex).flags.TargetNPC = 0
UserList(UserIndex).flags.TargetNpcTipo = 0
UserList(UserIndex).flags.TargetObj = 0
UserList(UserIndex).flags.TargetUser = 0
UserList(UserIndex).Char.FX = 0
'Controlamos no pasar el maximo de usuarios
If NumUsers >= MaxUsers Then
Call SendData(ToIndex, UserIndex, 0, "ERREl servidor ha alcanzado el maximo de usuarios soportado, por favor vuelva a intertarlo mas tarde.")
Call CloseSocket(UserIndex)
Exit Sub
End If
'¿Este IP ya esta conectado?
If AllowMultiLogins = 0 Then
If CheckForSameIP(UserIndex, UserList(UserIndex).ip) = True Then
Call SendData(ToIndex, UserIndex, 0, "ERRNo es posible usar mas de un personaje al mismo tiempo.")
Call CloseSocket(UserIndex)
Exit Sub
End If
End If
'¿Existe el personaje?
If FileExist(CharPath & UCase$(Name) & ".chr", vbNormal) = False Then
Call SendData(ToIndex, UserIndex, 0, "ERREl personaje no existe.")
Call CloseSocket(UserIndex)
Exit Sub
End If
' [Tavo 31-01-06]
'¿Puede Loguear?
If Not PuedeLogueo(UserIndex) Then
'Pero para..... ¿Ya paso su tiempo?
If LiberarPena(UserIndex) Then
Call WriteVar(App.Path & "\charfiles\" & UserList(UserIndex).Name & ".chr", "CONTROLPJ", "INTENTO", "0")
Else
Call SendData(ToIndex, UserIndex, 0, "ERRSu cuenta a sido bloqueada por intento de intruision, debe aguardar 30 minutos para que se vuelva a reestrablecer")
Call CloseSocket(UserIndex)
Exit Sub
End If
'[/Tavo 31-01-06]
'Posicion de comienzo
If UserList(UserIndex).Pos.Map = 0 Then
If UCase$(UserList(UserIndex).Hogar) = "NIX" Then
UserList(UserIndex).Pos = Nix
ElseIf UCase$(UserList(UserIndex).Hogar) = "ULLATHORPE" Then
UserList(UserIndex).Pos = Ullathorpe
ElseIf UCase$(UserList(UserIndex).Hogar) = "BANDERBILL" Then
UserList(UserIndex).Pos = Banderbill
ElseIf UCase$(UserList(UserIndex).Hogar) = "LINDOS" Then
UserList(UserIndex).Pos = Lindos
Else
UserList(UserIndex).Hogar = "ULLATHORPE"
UserList(UserIndex).Pos = Ullathorpe
End If
Else
''TELEFRAG
If MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex <> 0 Then
''si estaba en comercio seguro...
If UserList(MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex).ComUsu.DestUsu > 0 Then
If UserList(UserList(MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex).ComUsu.DestUsu).flags.UserLogged Then
Call FinComerciarUsu(UserList(MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex).ComUsu.DestUsu)
Call SendData(ToIndex, UserList(MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex).ComUsu.DestUsu, 0, "||Comercio cancelado. El otro usuario se ha desconectado." & FONTTYPE_TALK)
End If
If UserList(MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex).flags.UserLogged Then
Call FinComerciarUsu(MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex)
Call SendData(ToIndex, MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex, 0, "ERRAlguien se ha conectado donde te encontrabas, por favor reconéctate...")
End If
End If
Call CloseSocket(MapData(UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex)
End If
If UserList(UserIndex).flags.Muerto = 1 Then
Call Empollando(UserIndex)
End If
End If
If Not MapaValido(UserList(UserIndex).Pos.Map) Then
Call SendData(ToIndex, UserIndex, 0, "ERREL PJ se encuenta en un mapa invalido.")
Call CloseSocket(UserIndex)
Exit Sub
End If
'Nombre de sistema
UserList(UserIndex).Name = Name
UserList(UserIndex).Password = Password
'UserList(UserIndex).ip = frmMain.Socket2(UserIndex).PeerAddress
'Info
Call SendData(ToIndex, UserIndex, 0, "IU" & UserIndex) 'Enviamos el User index
Call SendData(ToIndex, UserIndex, 0, "CM" & UserList(UserIndex).Pos.Map & "," & MapInfo(UserList(UserIndex).Pos.Map).MapVersion) 'Carga el mapa
Call SendData(ToIndex, UserIndex, 0, "TM" & MapInfo(UserList(UserIndex).Pos.Map).Music)
''[EL OSO]: TRAIGO ESTO ACA ARRIBA PARA DARLE EL IP!
Set UserList(UserIndex).GuildRef = FetchGuild(UserList(UserIndex).GuildInfo.GuildName)
UserList(UserIndex).Counters.IdleCount = 0
'Crea el personaje del usuario
Call MakeUserChar(ToMap, 0, UserList(UserIndex).Pos.Map, UserIndex, UserList(UserIndex).Pos.Map, UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y)
Call SendData(ToIndex, UserIndex, 0, "IP" & UserList(UserIndex).Char.charindex)
''[/el oso]
Call UpdateUserMap(UserIndex)
Call SendUserStatsBox(UserIndex)
Call EnviarHambreYsed(UserIndex)
Call SendMOTD(UserIndex)
If haciendoBK Then
Call SendData(ToIndex, UserIndex, 0, "BKW")
Call SendData(ToIndex, UserIndex, 0, "||Servidor> Por favor espera algunos segundos, WorldSave esta ejecutandose." & FONTTYPE_SERVER)
End If
If EnPausa Then
Call SendData(ToIndex, UserIndex, 0, "BKW")
Call SendData(ToIndex, UserIndex, 0, "||Servidor> Lo sentimos mucho pero el servidor se encuentra actualmente detenido. Intenta ingresar más tarde." & FONTTYPE_SERVER)
End If
If EnTesting And UserList(UserIndex).Stats.ELV >= 18 Then
Call SendData(ToIndex, UserIndex, 0, "ERRServidor en Testing por unos minutos, conectese con PJs de nivel menor a 18. No se conecte con Pjs que puedan resultar importantes por ahora pues pueden arruinarse.")
Call CloseSocket(UserIndex)
Exit Sub
End If
'Actualiza el Num de usuarios
'DE ACA EN ADELANTE GRABA EL CHARFILE, OJO!
NumUsers = NumUsers + 1
UserList(UserIndex).flags.UserLogged = True
'usado para borrar Pjs
Call WriteVar(CharPath & UserList(UserIndex).Name & ".chr", "INIT", "Logged", "1")
Call EstadisticasWeb.Informar(CANTIDAD_ONLINE, NumUsers)
MapInfo(UserList(UserIndex).Pos.Map).NumUsers = MapInfo(UserList(UserIndex).Pos.Map).NumUsers + 1
If UserList(UserIndex).Stats.SkillPts > 0 Then
Call EnviarSkills(UserIndex)
Call EnviarSubirNivel(UserIndex, UserList(UserIndex).Stats.SkillPts)
End If
If NumUsers > DayStats.MaxUsuarios Then DayStats.MaxUsuarios = NumUsers
If NumUsers > recordusuarios Then
Call SendData(ToAll, 0, 0, "||Record de usuarios conectados simultaniamente." & "Hay " & NumUsers & " usuarios." & FONTTYPE_INFO)
recordusuarios = NumUsers
Call WriteVar(IniPath & "Server.ini", "INIT", "Record", str(recordusuarios))
Call EstadisticasWeb.Informar(RECORD_USUARIOS, recordusuarios)
End If
UserList(UserIndex).flags.EsRolesMaster = EsRolesMaster(Name)
If EsAdmin(Name) Then
UserList(UserIndex).flags.Privilegios = 4
Call LogGM(UserList(UserIndex).Name, "Se conecto con ip:" & UserList(UserIndex).ip, False)
ElseIf EsDios(Name) Then
UserList(UserIndex).flags.Privilegios = 3
Call LogGM(UserList(UserIndex).Name, "Se conecto con ip:" & UserList(UserIndex).ip, False)
ElseIf EsSemiDios(Name) Then
UserList(UserIndex).flags.Privilegios = 2
Call LogGM(UserList(UserIndex).Name, "Se conecto con ip:" & UserList(UserIndex).ip, False)
ElseIf EsConsejero(Name) Then
UserList(UserIndex).flags.Privilegios = 1
Call LogGM(UserList(UserIndex).Name, "Se conecto con ip:" & UserList(UserIndex).ip, True)
Else
UserList(UserIndex).flags.Privilegios = 0
End If
If UserList(UserIndex).NroMacotas > 0 Then
Dim i As Integer
For i = 1 To MAXMASCOTAS
If UserList(UserIndex).MascotasType(i) > 0 Then
UserList(UserIndex).MascotasIndex(i) = SpawnNpc(UserList(UserIndex).MascotasType(i), UserList(UserIndex).Pos, True, True)
If UserList(UserIndex).MascotasIndex(i) <= MAXNPCS Then
Npclist(UserList(UserIndex).MascotasIndex(i)).MaestroUser = UserIndex
Call FollowAmo(UserList(UserIndex).MascotasIndex(i))
Else
UserList(UserIndex).MascotasIndex(i) = 0
End If
End If
Next i
End If
If UserList(UserIndex).flags.Navegando = 1 Then Call SendData(ToIndex, UserIndex, 0, "NAVEG")
If Criminal(UserIndex) Then
'Call SendData(ToIndex, UserIndex, 0, "||Miembro de las fuerzas del caos > Seguro desactivado <" & FONTTYPE_FIGHT)
Call SendData(ToIndex, UserIndex, 0, "SEGOFF")
UserList(UserIndex).flags.Seguro = False
Else
UserList(UserIndex).flags.Seguro = True
Call SendData(ToIndex, UserIndex, 0, "SEGON")
End If
If ServerSoloGMs > 0 Then
If UserList(UserIndex).flags.Privilegios < ServerSoloGMs Then
Call SendData(ToIndex, UserIndex, 0, "ERRServidor restringido a administradores de jerarquia mayor o igual a: " & ServerSoloGMs & ". Por favor intente en unos momentos.")
Call CloseSocket(UserIndex)
Exit Sub
End If
End If
Call SendData(ToPCArea, UserIndex, UserList(UserIndex).Pos.Map, "CFX" & UserList(UserIndex).Char.charindex & "," & FXWARP & "," & 0)
Call SendData(ToIndex, UserIndex, 0, "LOGGED")
Call SendGuildNews(UserIndex)
If UserList(UserIndex).flags.NoActualizado Then
Call SendData(ToIndex, UserIndex, 0, "REAU")
End If
If Lloviendo Then Call SendData(ToIndex, UserIndex, 0, "LLU")
Call MostrarNumUsers
N = FreeFile
Open App.Path & "\logs\numusers.log" For Output As N
Print #N, NumUsers
Close #N
N = FreeFile
'Log
Open App.Path & "\logs\Connect.log" For Append Shared As #N
Print #N, UserList(UserIndex).Name & " ha entrado al juego. UserIndex:" & UserIndex & " " & Time & " " & Date
Close #N
'[Tavo 31-01-06]
'Pudo loguear correctamenta, asi que seteamos sus intentos a 0
Call WriteVar(App.Path & "\charfiles\" & UserList(UserIndex).Name & ".chr", "CONTROLPJ", "INTENTO", "0")
'[Tavo 31-01-06]
End Sub
Ahora en este mismo modulo, vamos abajo de todo, y ponemos lo siguiente:
Código:
Private Function PuedeLogueo(ByVal UserIndex As Integer) As Boolean
'###########################################
'### Coder: Lucas Tavolaro Ortiz ###
'### Function Name: PuedeLoguear ###
'### Date: 30/01/06 ###
'###########################################
'¿El Usuario puede loguear?
If GetVar(App.Path & "\charfiles\" & UserList(UserIndex).Name & ".chr", "CONTROLPJ", "INTENTO") = "5" Then
PuedeLoguear = False
Else
PuedeLoguear = True
End If
End Function
Private Sub LogueoFracasado(ByVal UserIndex As Integer)
'###########################################
'### Coder: Lucas Tavolaro Ortiz ###
'### Sub Name: LogueoFracasado ###
'### Date: 30/01/06 ###
'###########################################
'Fracaso el logueo , no estaras intentando de robar el pj?
Dim VecesFracasadas As Byte
VecesFracasadas = GetVar(App.Path & "\charfiles\" & UserList(UserIndex).Name & ".chr", "CONTROLPJ", "INTENTO")
'Escribimos en el archivo el nuevo intento
Call WriteVar(App.Path & "\charfiles\" & UserList(UserIndex).Name & ".chr", "CONTROLPJ", "INTENTO", VecesFracasadas + 1)
End Sub
Private Function LiberarPena(ByVal UserIndex As Integer) As Boolean
'###########################################
'### Coder: Lucas Tavolaro Ortiz ###
'### Function Name: LiberarPena ###
'### Date: 31/01/06 ###
'###########################################
Dim Dia As String, Hora As String
Dim OldDia As String, OldHora As String
Dim bHora As Byte, bOldHora As Byte
Dim bMinutos As Byte, bOldMinutos As Byte
'Asignacion de valores
Dia = Date
Hora = Time
OldDia = GetVar("\char\" & UserList(UserIndex).Name & ".chr", "CONTROLPJ", "FECHA")
OldHora = GetVar("\char\" & UserList(UserIndex).Name & ".chr", "CONTROLPJ", "HORA")
'Asignacion de Hora y Minutos
Select Case Len(Hora)
Case 4
bHora = Right(Hora, 1)
Case 5
bHora = Right(Hora, 2)
End Select
Select Case Len(OldHora)
Case 4
bOldHora = Right(OldHora, 1)
Case 5
bOldHora = Right(OldHora, 2)
End Select
Select Case Len(Minutos)
Case 4
bMinutos = Mid(Minutos, 3, 2)
Case 5
bMinutos = Mid(Minutos, 4, 2)
End Select
Select Case Len(OldMinutos)
Case 4
bOldMinutos = Mid(OldMinutos, 3, 2)
Case 5
bOldMinutos = Mid(OldMinutos, 4, 2)
End Select
'Comparacion Matematica
If Dia = OldDia Then 'El Dia es el mismo
'¿Pero si son de distintos meses o de dias iguales?
'Si hay diferencia de un año, o un mes, ya pasaron los 30 minutos
If bAño - bOldAño >= 1 Or bMes - bOldMes >= 1 Then
LiberarPena = True
Exit Sub
End If
If Right$(Hora, 1) = Right$(OldHora, 1) Then
If bMinutos - bOldMinutos >= 30 Then
LiberarPena = True
Else
LiberarPena = False
End If
Else
'Comprobamos si la Hora Actual es mayor a 1 de la oldHora, y damos por cierto que ya pasaron los 30 minutos
If bHora - bOldHora >= 1 Then
LiberarPena = True
Else
If (60 - bOldMinutos) + bMinutos >= 30 Then
LiberarPena = True
Else
LiberarPena = False
End If
End If
Else
If bHora - bOldHora >= 1 Then
LiberarPena = True
Else
If (60 - bOldMinutos) + bMinutos >= 30 Then
LiberarPena = True
Else
LiberarPena = False
End If
End If
End If
Else
' Los dias no son iguales!
Dim bAño As Byte, bOldAño As Byte
Dim bMes As Byte, bOldMes As Byte
Dim bDia As Byte, bOldDia As Byte
bAño = Mid(Dia, 7, 2)
bOldAño = Mid(OldDia, 7, 2)
bMes = Mid(Dia, 4, 2)
bOldMes = Mid(OldDia, 4, 2)
bDia = Right(Dia, 2)
bOldDia = Right(OldDia, 2)
'Empezando a comparar
If bAño - bOldAño >= 1 Then
LiberarPena = True
Exit Sub
End If
If bMes - bOldMes >= 1 Then
'Chequeo de dias
If bDia >= 1 Then
LiberarPena = True
Else
'Chequeo de horas y minutos
If 60 - bMinutos + bOldMinutos >= 30 Then
LiberarPena = True
Else
LiberarPena = False
End If
End If
Exit Sub
Else
'[Razonamiento logico]
'Si los meses ya son iguales, entonces ya paso un año, o sea mas de 30 mins
LiberarPena = True
Exit Sub
End If
If bMes - bOldMes >= 1 Then
LiberarPena = True
Else
'Contamos los dias....
If bDia - bOldDia >= 1 Then
LiberarPena = True
Else
If 60 - bMinutos + bOldMinutos >= 30 Then
LiberarPena = True
Else
LiberarPena = False
End If
End If
End If
End If
End Function
Espero que les sirva de utilidad, cualquier BUG por favor reportenmelo.
Este sistema sera usado en el Ao-Ready y en el GSS :O
Original Idea By GS !