modmainserver.vb.svn-base

MirUnleashed vb.net Module modMainServer Public WithEvents Socket As New WinsockServer Pub

        If CheckTablesMatch(Locals, Player.LocalObjects) = False Then
            'Locals Changed
            Dim k, tPlayerID As Integer

            'Send Appears

            'PLAYERS
            If Not Locals.Count = 0 Then
                For k = 0 To Locals.Count - 1
                    If Not Locals(k) Is Nothing Then

                        'Current Local Players ID
                        tPlayerID = Locals(k)
                        '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
                    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

            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 Items
            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
            Player.LocalDropItems = LocalItems
        End If


        ''PLAYERS
        'Dim tPlayerID, k As Integer
        ''For i = 0 To Locals.Count - 1
        ''    tPlayerID = Locals(i)
        ''    tPlayer = ObjectList(tPlayerID)
        ''    If Not tPlayerID = Player.StateId And Not Added.Contains(tPlayer.StateId) Then
        ''        Packets.SendAppears(State.Index, tPlayer.StateId, Races.Player, GetPlayerBuffer(tPlayer))
        ''        Added.Add(tPlayer.StateId, "")
        ''    End If
        ''Next i

        'If Not Locals.Count = 0 Then
        '    For k = 0 To Locals.Count - 1
        '        If Not Locals(k) Is Nothing Then

        '            'Current Local Players ID
        '            tPlayerID = Locals(k)
        '            'If Players Local Players Doesnt Contain the Local Players ID
        '            If Not Player.LocalObjects.Contains(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(FreeSlot, Player.StateId)
        '                    Packets.SendAppears(tPlayer.StateId, Player.StateId, Races.Player, GetPlayerBuffer(Player))
        '                End If
        '                Packets.SendAppears(Player.StateId, tPlayer.StateId, Races.Player, GetPlayerBuffer(tPlayer))
        '                Added.Add(tPlayer.StateId, "")
        '            End If

        '        End If
        '    Next k
        'End If

        'Added.Clear()

        ''MONSTERS
        'Dim tMonsterID, l As Long
        'For l = 0 To Locals.Count - 1
        '    If Not ObjectList(tMonsterID) Is Nothing Then

        '    End If
        'Next l

        ' ''NPCS
        ''Dim tNpcID, k As Short
        ''Dim tNpc As clsNpc
        ''For k = 0 To Locals.Count - 1
        ''    tNpcID = Locals(k)
        ''    tNpc = ObjectList(tNpcID)
        ''    If Not tNpc Is Nothing Then
        ''        Packets.SendAppears(State.Index, tNpcID, Races.Npc, GetNpcBuffer(tNpc))
        ''    End If
        ''Next k


        'Player.LocalObjects = Locals
    End Sub

#End Region
#Region "ProcessPlayerDisappear"

    Public Sub ProcessPlayerDisappear(ByVal Index As Integer)
        Dim Player As clsPlayer = ObjectList(Index)
        Dim Added As New Hashtable
        Dim tPlayerID, i As Integer
        Dim tPlayer As clsPlayer

        If Player.LocalObjects.Count = 0 Then Exit Sub

        For i = 0 To Player.LocalObjects.Count - 1
            If Not Player.LocalObjects(i) Is Nothing Then

                tPlayerID = Player.LocalObjects(i)
                If Not Added.Contains(tPlayerID) Then
                    tPlayer = ObjectList(tPlayerID)
                    tPlayer.LocalObjects.Remove(Player.StateId)
                    Player.LocalObjects.Remove(tPlayerID)
                    Packets.SendDisappear(tPlayerID, Player.StateId, Races.Player)
                    Added.Add(tPlayerID, "")
                End If

            End If
        Next i

    End Sub

#End Region

#Region "ProcessMove"

    Public Sub ProcessMove(ByVal Header As Header, ByVal State As State)
        Dim Steps As Byte = Header.wSeries
        Dim Dir As Byte = Header.wTag

        Dim Player As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
        Dim PlayerMap As Map = Maps(Player.Map)

        If Player.IsDead Or Player.Poison = clsPlayer.Poisons.Paralysis Then
            Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
            Exit Sub
        End If

        'If Player.LastMove + (Player.MoveSpeed * 10000) > DateTime.Now.Ticks Then
        '    'Packets.SendMoveFail(State.Index, Player.X, Player.Y)
        '    'Exit Sub
        'End If

        Dim Target As Point
        Target.X = Header.nRecog
        Target.Y = Header.wParam

        Dim PointXY As Point
        PointXY.X = Player.X
        PointXY.Y = Player.Y

        Dim EndPoint As Point
        EndPoint = IsNextWalkDir(Dir, PointXY)
        Dim EndPoint2 As Point
        EndPoint2 = IsNextWalkDir(Dir, EndPoint)

        If Steps = 1 Then
            If Target.Equals(EndPoint) = False Then
                'Walk failed once
                'Player.MoveFail += 1
                Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
                Exit Sub
            Else
                'Player.MoveFail = 0
            End If
        End If

        If Steps = 2 Then
            If Target.Equals(EndPoint2) = False Then
                'Run failed once
                'Player.MoveFail += 1
                Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
            Else
                'Player.MoveFail = 0
            End If
        End If

        If CanWalk(EndPoint, Player.Map) = False Then
            Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
            Exit Sub
        End If

        If Steps = 2 Then
            If CanWalk(EndPoint2, Player.Map) = False Then
                Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
                Exit Sub
            End If
        End If


        'Player can walk
        If PlayerMap.Doors.Contains(EndPoint.X & "/" & EndPoint.Y) Then
            AddLog("Maps", "Change map here")
            Exit Sub
        End If

        If Steps = 2 Then
            If PlayerMap.Doors.Contains(EndPoint2.X & "/" & EndPoint2.Y) Then
                AddLog("Maps", "Change map here")
                Exit Sub
            End If
        End If

        Dim Done As Boolean = False
        Dim Removed As Boolean = False
        Dim i As Integer
        Dim tX, tY As Short
        tX = EndPoint.X
        tY = EndPoint.Y
        If Steps = 2 Then
            tX = EndPoint2.X
            tY = EndPoint2.Y
        End If
        If PlayerMap.ObjectList.ContainsValue(Player.StateId) Then
            Dim tPlayerID As Integer
            Dim GotId As Boolean = False

            For i = 0 To 9
                If Not Done Then

                    If GotId = False Then
                        tPlayerID = PlayerMap.ObjectList(Player.X & "/" & Player.Y & "/" & i)
                        GotId = True
                    End If
                    If tPlayerID = Player.StateId Then
                        If Removed = False Then
                            PlayerMap.ObjectList.Remove(Player.X & "/" & Player.Y & "/" & i)
                            Removed = True
                        End If
                        If PlayerMap.ObjectList.Contains(tX & "/" & tY & "/" & i) = False Then
                            Player.LastX = Player.X
                            Player.LastY = Player.Y
                            Player.Dir = Dir
                            Player.X = tX
                            Player.Y = tY
                            PlayerMap.ObjectList.Add(Player.X & "/" & Player.Y & "/" & i, Player.StateId)
                            Done = True
                            Player.LastMove = DateTime.Now.Ticks
                            Exit For
                        End If
                    End If

                End If
            Next
        End If


        If Done = True Then
            'Get Players Local Players
            Dim Locals As Hashtable = GetLocalObjects(Player.X, Player.Y, Player.Map, 15, 15, Player.StateId)
            Dim tPlayerID As Integer
            Dim j As Integer

            If Not Locals.Count = 0 Then

                'Tell everyone a player walked
                For j = 0 To Locals.Count - 1
                    If Not Locals(j) Is Nothing Then

                        tPlayerID = Locals(j)
                        If Not tPlayerID = Player.StateId Then
                            Packets.SendMove(tPlayerID, Player.StateId, Races.Player, Player.X, Player.Y, Player.Dir, Steps)
                        End If

                    End If
                Next j

            End If

            Dim Added As New Hashtable

            If CheckTablesMatch(Locals, Player.LocalObjects) = False Then
                'Locals Changed
                Dim k As Integer
                Dim tPlayer As New clsPlayer

                'Send Appears

                'PLAYERS
                If Not Locals.Count = 0 Then
                    For k = 0 To Locals.Count - 1
                        If Not Locals(k) Is Nothing Then
                            'Its a player
                            tPlayerID = Locals(k)