?? modmainserver.vb.svn-base
字號:
Imports System.Text
Imports System.Security.Cryptography
Module modMainServer
Public WithEvents Socket As New WinsockServer
Public WithEvents StatusSocket As New WinsockServer
Dim MonsterThread As New System.Threading.Thread(AddressOf MonsterProcess)
Dim LastPacket As String = ""
#Region "Start Server"
Public Sub StartServer()
If Config.EnableLogging = True Then
LogStream = New IO.FileStream(Config.LogDir & LogFile & ".txt", IO.FileMode.Append)
End If
Log(":Game Server started", "", 1)
AddLog("SQL", "Connecting to SQL...")
ConnectSQL()
LoadItemID()
AddLog("Server", "Loading Exp Data...")
LoadExp()
AddLog("Server", "Exp Data Loaded.")
AddLog("Server", "Loading Maps...")
FillMapList()
GetDoors()
AddLog("Server", "Maps Loaded.")
AddLog("Server", "Loading Npcs...")
LoadNpcs()
AddLog("Server", "Npcs Loaded.")
AddLog("Server", "Loading Items...")
LoadItemStatList()
AddLog("Server", "Items Loaded.")
AddLog("Server", "Loading Monsters...")
LoadMonsterStats()
LoadSpawnTable()
AddLog("Server", "Monsters Loaded.")
AddLog("Server", "Loading Magics...")
LoadMagics()
AddLog("Server", "Magics Loaded.")
AddLog("Server", "Loading Players Items...")
LoadPlayerItems()
AddLog("Server", "Players Items Loaded.")
AddLog("Server", "Loading GameMaster List...")
LoadGameMasterList()
AddLog("Server", "GameMaster List Loaded.")
AddLog("Server", "Loading Notice...")
LoadNotice()
AddLog("Server", "Notice Loaded.")
AddLog("Game Server", "Loading Guild List...")
LoadGuilds()
AddLog("Game Server", "Guild List Loaded.")
AddLog("Server", "Starting Monsters AI...")
MonsterThread.IsBackground = True
MonsterThread.Start()
AddLog("Server", "Monster AI Started.")
Socket.Listen(Config.GamePort)
StatusSocket.Listen(25000)
AddLog("Socket", "Listening on Port: " & Config.GamePort)
AddLog("::::Game Server started::::", "")
End Sub
#End Region
#Region "Socket Handles"
Private Sub Socket_onDataArrival(ByVal sData() As Byte, ByVal State As modSocket.State) Handles Socket.onDataArrival
Dim Packet As String
Dim Pieces() As String
Dim iTotalBytes As Integer = GetByteCount(sData)
ReDim Preserve sData(iTotalBytes)
Packet = System.Text.Encoding.ASCII.GetString(sData)
'MsgBox(Len(Packet2))
If Not LastPacket = "" Then
Packet = LastPacket & Packet
LastPacket = ""
End If
If Not Right(Packet, 1) = Chr(30) Then
LastPacket = Packet
Exit Sub
End If
'add the old packet to new
Packet = LastPacket & Packet
Pieces = Split(Packet, Chr(30))
Dim R As Integer
For R = LBound(Pieces) To UBound(Pieces)
Packet = Pieces(R)
If Not Packet = "" Then ProcessPacket(Packet, State)
Next R
End Sub
Private Sub ProcessPacket(ByVal Packet As String, ByVal State As State)
Dim Body As String
Dim Header As Header
'Packet = System.Text.Encoding.ASCII.GetString(Data)
'If Packet.Contains(":/") Then
' Dim Packet2 As String
' Dim n As Integer
' For n = 0 To 9
' Packet2 = GetTok(Packet, n, ":/")
' If Packet2 = "failure" Then Exit Sub
' Packet2 &= ":"
' Socket.SplitDataSend(Packet2, State)
' Next n
' Exit Sub
'End If
Header = DecodePacketHeader(Packet)
Body = DecodePacketBody(Packet)
If Socket.Lst.GetLogin(State.Index) = "" Then
NewConnection(Body, State)
Exit Sub
End If
Select Case Header.wIdent
Case GameMsg.CM_GOGAME
ProcessGoGame(State)
Case GameMsg.CM_MOVE
ProcessMove(Header, State)
Case GameMsg.CM_TURN
ProcessTurn(Header, State)
Case GameMsg.CM_CHAT
ProcessChat(Body, State)
Case GameMsg.CM_CLICKNPC
ProcessClickNpc(Header, State)
Case GameMsg.CM_CLICKNPC_MENU
ProcessClickNpcMenu(Header, Body, State)
Case GameMsg.CM_NORMAL_HIT
ProcessHit(Header, State)
Case GameMsg.CM_TWOHANDED_HIT
Case GameMsg.CM_PICKAXE_HIT
Case GameMsg.CM_USEMAGIC
ProcessMagicAttack(Header, State)
Case GameMsg.CM_WEAR_ITEM
ProcessWearItem(Header, State)
Case GameMsg.CM_TAKEOFF_ITEM
ProcessTakeOffItem(Header, State)
Case GameMsg.CM_DROP_ITEM
ProcessDropItem(Header, State)
Case GameMsg.CM_PICKUP_ITEM
ProcessPickupItem(Header, State)
Case GameMsg.CM_USE_ITEM
ProcessUseItem(Header, State)
Case GameMsg.CM_REQUEST_GUILDINFO
ProcessRequestGuildInfo(State)
End Select
End Sub
Private Sub Socket_onAccept(ByVal State As State) Handles Socket.onAccept
AddLog("Socket", Socket.Lst.GetIP(State.Index) & " Connected.")
Log("User Connected", "IP: " & Socket.Lst.GetIP(State.Index))
UserCount += 1
FrmMain.UpdateUserCount()
End Sub
Private Sub Socket_onDisconnect(ByVal State As modSocket.State) Handles Socket.onDisconnect
Dim Player As clsPlayer
Player = ObjectList(State.Index)
If Not Player Is Nothing Then
'Tell everyone we quit
ProcessPlayerDisappear(State.Index)
SavePlayerData(Player)
SavePlayerItems(Player)
Dim PlayerMap As Map = Maps(Player.Map)
Dim i As Integer
For i = 0 To 9
If PlayerMap.ObjectList.Contains(Player.X & "/" & Player.Y & "/" & i) Then
If PlayerMap.ObjectList(Player.X & "/" & Player.Y & "/" & i) = Player.StateId Then
PlayerMap.ObjectList.Remove(Player.X & "/" & Player.Y & "/" & i)
End If
End If
Next
AddLog("User Disconnected", Player.Name & " has left the server.")
AddLog("Socket", Socket.Lst.GetIP(State.Index) & " Disconnected.")
Log("User Disconnected", "Character: " & Player.Name & " IP: " & Socket.Lst.GetIP(State.Index))
UserCount -= 1
FrmMain.UpdateUserCount()
PlayerList.Remove(Player.Name)
FrmMain.lstPlayers.Items.Remove(Player.Name)
ObjectList.Remove(State.Index)
Socket.Lst.Remove(State.Index)
Else
AddLog("Socket", Socket.Lst.GetIP(State.Index) & " Disconnected.")
Log("User Disconnected", "IP: " & Socket.Lst.GetIP(State.Index))
UserCount -= 1
FrmMain.UpdateUserCount()
Socket.Lst.Remove(State.Index)
End If
End Sub
Private Sub Socket_onError(ByVal err As String, ByVal State As State) Handles Socket.onError
If State Is Nothing Then
Exit Sub
End If
'AddLog("Socket Error", Socket.Lst.GetIP(State.Index) & ": " & err)
End Sub
#Region "Status Socket"
Private Sub StatusSocket_onAccept(ByVal State As modSocket.State) Handles StatusSocket.onAccept
AddLog("Status Socket", StatusSocket.Lst.GetIP(State.Index) & " recieved the user count.")
StatusSocket.SendData(UserCount, State.Index)
StatusSocket.DisconnectUser(State.Index)
End Sub
#End Region
#End Region
#Region "Processing"
#Region "NewConnection"
Public Sub NewConnection(ByVal Body As String, ByVal State As State)
Dim Username As String = GetTok(Body, 0, "/")
Dim Character As String = GetTok(Body, 1, "/")
Dim Certification As String = GetTok(Body, 2, "/")
Dim Version As String = GetTok(Body, 3, "/")
Dim Password As String = GetTok(Body, 4, "/")
Password = GenerateHash(Password)
If CheckLogin(Username, Password) Then
If Trim(Version) = Config.ClientVersion Then
If CheckCert(Username, Certification) Then
If CharExistOnAcc(Username, Character) Then
Packets.SendNotice(Notice, State.Index)
Socket.Lst.SetLogin(State.Index, Username)
Socket.Lst.SetCharacter(State.Index, Character)
AddLog("User Connected", Character & " has connected to the server.")
FrmMain.lstPlayers.Items.Add(Character)
Else
AddLog("Error", Username & " tried to login onto " & Character & " from a different account.")
Packets.SendNoticeFail(State.Index)
End If
Else
AddLog("Error", Username & " tried to login with wrong certification.")
Packets.SendNoticeFail(State.Index)
End If
Else
AddLog("Incorrect Client", Username & " tried to login with wrong client.")
Packets.SendNoticeFail(State.Index)
End If
Else
AddLog("Error", Username & " tried to join the server with wrong Username or Password")
Packets.SendNoticeFail(State.Index)
End If
End Sub
#End Region
#Region "ProcessGoGame"
Public Sub ProcessGoGame(ByVal State As State)
Dim PlayerName As String = Socket.Lst.GetCharacter(State.Index)
If Not PlayerList(PlayerName) Is Nothing Then Exit Sub
If PlayerList.Contains(PlayerName) Then Exit Sub 'Player already online
Dim i As Integer
Dim Player As New clsPlayer
Player.LoadPlayer(PlayerName)
Player.StateId = State.Index
'Adds Player to Objectlist and Playerlist
If ObjectList.Contains(State.Index) = False Then
ObjectList.Add(State.Index, Player)
PlayerList.Add(PlayerName, State.Index)
End If
Dim CheckMap As Map = Maps.Item(Player.Map)
Dim Added As Boolean = False
While i < 10 And Added = False
If CheckMap.ObjectList.Contains(Player.X & "/" & Player.Y & "/" & i) = False Then
CheckMap.ObjectList.Add(Player.X & "/" & Player.Y & "/" & i, PlayerList(PlayerName))
Added = True
End If
i += 1
End While
Packets.SendNewMap(Player.StateId, Player.X, Player.Y, CheckMap.LightMode, CheckMap.MapFilename, CheckMap.MapName)
Packets.SendCharStatus(Player.StateId, Player.Light, Player.Reved, Player.Name, Player.NameColour, Player.IsDead, Player.Gender, Player.GuildName, Player.GuildTitle, Player.GuildRank)
Packets.SendBagItems(Player)
Packets.SendEquipment(Player)
Packets.SendMagics(Player)
Packets.SendPlayerStats(Player.StateId, Player.Gold, Player.Job, GetPlayerStats(Player))
Packets.SendChatMessage(Player.StateId, ChatColours.Green, Player.GetAttackMode, Player.StateId)
Packets.SendChatMessage(Player.StateId, ChatColours.Green, "To change do: CTRL-H", Player.StateId)
Packets.SendChatMessage(Player.StateId, ChatColours.Green, WelcomeMessage, Player.StateId)
Packets.SendGoGame(Player.StateId, ToByte(Player.AllowGroup), ToByte(Player.AllowGroupRecall), Player.AttackMode, Player.Dir)
ProcessMyAppears(State)
End Sub
#End Region
#Region "ProcessMyAppears"
Public Sub ProcessMyAppears(ByVal State As State)
Dim Player As clsPlayer = ObjectList(State.Index)
Dim tPlayer As New clsPlayer
Dim Added As New Hashtable
Dim Locals As Hashtable = GetLocalObjects(Player.X, Player.Y, Player.Map, 15, 15, Player.StateId)
If Locals.Count = 0 Then Exit Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -