⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modmainserver.vb.svn-base

📁 MirUnleashed vb.net Module modMainServer Public WithEvents Socket As New WinsockServer Pub
💻 SVN-BASE
📖 第 1 页 / 共 5 页
字号:
                            'If Players Local Players Doesnt Contain the Local Players ID
                            If Not Player.LocalObjects.ContainsValue(tPlayerID) And Not Added.Contains(tPlayerID) Then
                                tPlayer = ObjectList(tPlayerID)
                                If tPlayer.LocalObjects.ContainsValue(Player.StateId) = False Then
                                    'Dim FreeSlot As Integer = GetFreePlayerSlot(tPlayer.LocalObjects)
                                    tPlayer.LocalObjects.Add(Player.StateId, Player.StateId)
                                    Packets.SendAppears(tPlayer.StateId, Player.StateId, Races.Player, GetPlayerBuffer(Player))
                                    Packets.SendPlayerLookChanged(tPlayer.StateId, Player.StateId, GetPlayerLooks(Player))
                                End If
                                Packets.SendAppears(Player.StateId, tPlayer.StateId, Races.Player, GetPlayerBuffer(tPlayer))
                                Packets.SendPlayerLookChanged(Player.StateId, tPlayer.StateId, GetPlayerLooks(tPlayer))
                                Added.Add(tPlayer.StateId, "")
                            End If

                        End If
                    Next k
                End If

                Added.Clear()

                'MONSTERS
                Dim l, tMonsterId As Long
                Dim tMonster As New clsMonster
                For l = 0 To Locals.Count - 1
                    If Not Locals(l) Is Nothing Then
                        'Its a monster
                        tMonsterId = Locals(l)
                        If Not Player.LocalObjects.ContainsValue(tMonsterId) And Not Added.Contains(tMonsterId) Then
                            tMonster = ObjectList(tMonsterId)
                            Packets.SendAppears(State.Index, tMonsterId, Races.Monster, GetMonsterBuffer(tMonster))
                            Added.Add(tMonsterId, "")
                        End If
                    End If
                Next l

                Added.Clear()

                'NPCS
                Dim tNpcID, g As Short
                Dim tNpc As New clsNpc
                For g = 0 To Locals.Count - 1
                    If Not Locals(g) Is Nothing Then
                        'Its a Npc
                        tNpcID = Locals(g)
                        If Not Player.LocalObjects.ContainsValue(tNpcID) And Not Added.Contains(tNpcID) Then
                            tNpc = ObjectList(tNpcID)
                            Packets.SendAppears(State.Index, tNpcID, Races.Npc, GetNpcBuffer(tNpc))
                            Added.Add(tNpcID, "")
                        End If
                    End If
                Next g

                Added.Clear()

                'Send Disappears

                'PLAYERS
                For k = 0 To Player.LocalObjects.Count - 1
                    If Not Player.LocalObjects(k) Is Nothing Then
                        'Its a player
                        tPlayerID = Player.LocalObjects(k)
                        'If Locals Doesnt Contain the Players Local Players ID
                        If Not ObjectList(tPlayerID) Is Nothing And Not Locals.ContainsValue(tPlayerID) And Not Added.Contains(tPlayerID) And Not tPlayerID = Player.StateId Then
                            tPlayer = ObjectList(tPlayerID)
                            If tPlayer.LocalObjects.ContainsValue(Player.StateId) = True Then
                                'Dim Key As Integer = GetPKeyFromValue(tPlayer.LocalObjects, Player.StateId)
                                tPlayer.LocalObjects.Remove(Player.StateId)
                                Packets.SendDisappear(tPlayerID, Player.StateId, Races.Player)
                            End If
                            Packets.SendDisappear(Player.StateId, tPlayerID, Races.Player)
                            Added.Add(tPlayerID, "")
                        End If

                    End If
                Next k

                Added.Clear()

                'MONSTERS
                For l = 0 To Player.LocalObjects.Count - 1
                    If Not Player.LocalObjects(l) Is Nothing Then
                        'Its a monster
                        tMonsterId = Player.LocalObjects(l)
                        If Not Locals.ContainsValue(tMonsterId) And Not Added.Contains(tMonsterId) Then
                            Packets.SendDisappear(State.Index, tMonsterId, Races.Monster)
                            Added.Add(tMonsterId, "")
                        End If
                    End If
                Next l

                Added.Clear()

                'NPCS
                For g = 0 To Player.LocalObjects.Count - 1
                    If Not Player.LocalObjects(g) Is Nothing Then
                        'Its a npc
                        tNpcID = Player.LocalObjects(g)
                        If Not Locals.ContainsValue(tNpcID) And Not Added.Contains(tNpcID) Then
                            Packets.SendDisappear(State.Index, tNpcID, Races.Npc)
                            Added.Add(tNpcID, "")
                        End If
                    End If
                Next g

                Player.LocalObjects = Locals
            End If

            Added.Clear()

            Dim LocalItems As Hashtable = GetLocalDropItems(Player.X, Player.Y, Player.Map, 15, 15)

            If CheckTablesMatch(LocalItems, Player.LocalDropItems) = False Then
                'Send Drop Item Appears
                Dim n, ItemID As Long
                Dim lItem As clsPlayerItem
                Dim RealItem As clsItem

                For n = 0 To LocalItems.Count - 1
                    If Not LocalItems(n) Is Nothing Then
                        ItemID = LocalItems(n)
                        If Not Player.LocalDropItems.Contains(ItemID) And Not Added.Contains(ItemID) Then
                            lItem = PlayerItemList(ItemID)
                            RealItem = ItemStatList(lItem.ItemIndex)
                            Packets.SendItemDropped(Player.StateId, lItem.ItemID, lItem.X, lItem.Y, RealItem.Looks, RealItem.Name)
                            Added.Add(lItem.ItemID, "")
                        End If
                    End If
                Next n

                Added.Clear()

                'Send Drop Item Disappears
                For n = 0 To Player.LocalDropItems.Count - 1
                    If Not Player.LocalDropItems(n) Is Nothing Then
                        ItemID = Player.LocalDropItems(n)
                        If Not LocalItems.Contains(ItemID) And Not Added.Contains(ItemID) Then
                            Packets.SendRemoveDropItem(State.Index, ItemID)
                            Added.Add(ItemID, "")
                        End If
                    End If
                Next n

                Player.LocalDropItems = LocalItems
            End If

        End If

    End Sub

#End Region
#Region "ProcessTurn"

    Public Sub ProcessTurn(ByVal Header As Header, ByVal State As State)
        Dim Player As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
        Dim PlayerMap As Map = Maps(Player.Map)

        If Player.IsDead Then
            Packets.SendTurnFail(State.Index, Player.X, Player.Y, Player.Dir)
            Exit Sub
        End If

        If Player.X <> Header.nRecog Or Player.Y <> Header.wParam Then
            Packets.SendTurnFail(State.Index, Player.X, Player.Y, Player.Dir)
            Exit Sub
        End If


        'Player can turn
        Player.Dir = Header.wTag
        Packets.SendTurn(State.Index, Player.StateId, Races.Player, Player.Dir)

        'Tell everyone a player turned
        Dim Locals As Hashtable = GetLocalPlayers(Player.X, Player.Y, Player.Map, 15, 15)
        Dim lPlayer As clsPlayer
        Dim i As Integer
        Dim pID As Integer
        Dim Added As New Hashtable

        For i = 0 To Locals.Count - 1
            pID = Locals(i)

            If Not Added.ContainsKey(pID) Then
                lPlayer = ObjectList(pID)
                Packets.SendTurn(lPlayer.StateId, Player.StateId, Races.Player, Player.Dir)
                Added.Add(pID, "")
            End If
        Next i
    End Sub

#End Region

#Region "ProcessChat"

    Public Sub ProcessChat(ByVal Body As String, ByVal State As State)
        If Body.Length <= 0 Or Body.Length > 255 Then
            Exit Sub
        End If

        Dim TargetId As Integer
        Dim TargetName As String

        If Body.StartsWith("/") Then
            If Body.ToLower = "/who" Then
                'Tell player how many users online
                Packets.SendChatMessage(State.Index, ChatColours.White, "Users On: " & FrmMain.lstPlayers.Items.Count & ".", State.Index)
                Exit Sub
            End If

            'Private messages
            TargetName = GetTok(Body, 0, " ").Substring(1)
            If PlayerList.Contains(TargetName) = False Then
                Packets.SendChatMessage(-1, ChatColours.Red, TargetName & " not found.", State.Index)
                Exit Sub
            Else
                TargetId = PlayerList(TargetName)
                Packets.SendChatMessage(-1, ChatColours.Blue, Socket.Lst.GetCharacter(State.Index) & "=> " & Body.Substring(TargetName.Length + 1), TargetId)
                Exit Sub
            End If
        End If

        If Body.StartsWith("@") Then
            Dim Player As clsPlayer = ObjectList(State.Index)
            DoGMCommand(Player, Body.Substring(1))
            Exit Sub
        End If

        If Body.StartsWith("!") Then
            'Shouts
            Dim Shouter As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
            DoShout(Shouter, Body.Substring(1))
            Exit Sub
        End If


        Dim Chatter As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
        DoChat(Chatter, Body)
        Exit Sub
    End Sub

#End Region

#Region "ProcessClickNpc"

    Public Sub ProcessClickNpc(ByVal Header As Header, ByVal State As State)
        Dim NpcsId As Short = Header.nRecog
        Dim Npc As clsNpc

        If ObjectList.Contains(NpcsId) Then
            Npc = ObjectList(NpcsId)
            Npc.ProccessNpc(State.Index, "@main")
        End If
    End Sub

#End Region
#Region "ProcessClickNpcMenu"

    Public Sub ProcessClickNpcMenu(ByVal Header As Header, ByVal Body As String, ByVal State As State)
        Dim NpcsId As Short = Header.nRecog
        Dim Npc As clsNpc

        If ObjectList.Contains(NpcsId) Then
            Npc = ObjectList(NpcsId)
            Npc.ProccessNpc(State.Index, Body)
        End If
    End Sub

#End Region

#Region "ProcessHit"

    Public Sub ProcessHit(ByVal Header As Header, ByVal State As State)        
        Dim Player As clsPlayer = ObjectList(State.Index)

        '########################'
        '###CHECK THEY CAN HIT###'
        '########################'

        If Player.IsDead Or Player.X <> Header.nRecog Or Player.Y <> Header.wParam Or Player.Poison = clsPlayer.Poisons.Paralysis Then
            Packets.SendHitFail(State.Index)
            Exit Sub
        End If

        '#####################'
        '###IF THEY CAN HIT###'
        '#####################'

        'Tell them they can hit
        Packets.SendHitOk(State.Index)
        Player.Dir = Header.wTag

        '#####################'
        '###FIND THE TARGET###'
        '#####################'

        Dim CheckMap As Map = Maps(Player.Map)
        'Find the Cords they are attacking
        Dim Target As Point = IsNextWalkDir(Player.Dir, New Point(Player.X, Player.Y))
        Dim TargetId As Object
        Dim TargetRace As Races
        Dim i As Integer
        Dim GotTarget As Boolean

        'Find Target Id
        While i < 10 And GotTarget = False
            If Not CheckMap.ObjectList(Target.X & "/" & Target.Y & "/" & i) Is Nothing Then
                TargetId = CheckMap.ObjectList(Target.X & "/" & Target.Y & "/" & i)
                GotTarget = True
            End If
            i += 1
        End While

        Dim Locals As Hashtable = GetLocalObjects(Player.X, Player.Y, Player.Map, 15, 15, -1)
        Dim Added As New Hashtable
        Dim lPlayerId As Integer

        '##########################'
        '###TELL EVERYONE WE HIT###'
        '##########################'

        For i = 0 To Locals.Count - 1
            If Not Locals(i) Is Nothing Then
                'Its a player
                lPlayerId = Locals(i)
                If Not Added.Contains(lPlayerId) And Not lPlayerId = Player.StateId Then
                    Packets.SendHit(lPlayerId, Player.StateId, Races.Player, Player.Dir)
                    Added.Add(lPlayerId, "")
                End If
            End If
        Next i

        Added.Clear()

        If Not GotTarget Then
            'We have no target
            Exit Sub
        End If

        Dim Damage As Short 'Amount of damage
        Dim WillHit As Boolean = False 'Will it hit or not?

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -