clsplayer.vb.svn-base

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

                Return Config.StartItem5
        End Select
    End Function

#End Region

#End Region

#Region "Player Actions"

#Region "Died"

    Public Sub Died()
        'CHECK FOR REVIVAL RING
        Me.HP = 0
        Me.IsDead = True
    End Sub

#End Region
#Region "AddItemToBag"

    Public Sub AddItemToBag(ByVal Item As clsPlayerItem)
        Dim rItem As clsItem = ItemStatList(Item.ItemIndex)
        Item.Character = Name
        Item.Type = EquipType.Bag
        BagItems(GetEmptyBagSlot) = Item
        Weight += rItem.Weight
        PlayerItemList.Remove(Item.ItemID)
        PlayerItemList.Add(Item.ItemID, Item)
    End Sub

#End Region
#Region "RemoveItemFromBag"

    Public Sub RemoveItemFromBag(ByVal Item As clsPlayerItem)
        Dim rItem As clsItem = ItemStatList(Item.ItemIndex)
        Dim Index As Integer = FindItemInBag(Item.ItemID)
        If Index = -1 Then
            Exit Sub
        End If
        Weight -= rItem.Weight

        BagItems(Index) = Nothing
        PlayerItemList.Remove(Item.ItemID)
    End Sub

#End Region
#Region "PickupItem"

    Public Function PickupItem(ByVal ItemID As Long) As Integer
        Dim Map As Map = Maps(Me.Map)

        If Map.Drops.ContainsValue(ItemID) Then
            'Item exists on the map
            Dim pItem As clsPlayerItem = PlayerItemList(ItemID)
            If Not pItem Is Nothing Then
                If pItem.X = Me.X And pItem.Y = Me.Y Then
                    PlayerItemList.Remove(pItem.ItemID)
                    Dim sKey As String = GetKeyFromValue(Map.Drops, ItemID)
                    Map.Drops.Remove(sKey)
                    Dim sKey1 As Long = GetKeyFromValue(LocalDropItems, ItemID)
                    LocalDropItems.Remove(sKey1)
                    AddItemToBag(pItem)
                    Return 0
                End If
            End If
        End If
        Return 2
    End Function

#End Region
#Region "DropItem"

    Public Sub DropItem(ByVal ItemID As Long)
        Dim Index As Integer = FindItemInBag(ItemID)
        If Index = -1 Then
            Exit Sub
        End If
        Dim Item As clsPlayerItem = BagItems(Index)
        Dim rItem As clsItem = ItemStatList(Item.ItemIndex)

        RemoveItemFromBag(Item)
        Item.Character = ""
        Item.Type = EquipType.Floor
        DoDropItem(Item, Me.X, Me.Y, Me.Map)
        PlayerItemList.Add(Item.ItemID, Item)
    End Sub

#End Region
#Region "DeleteItem"

    Public Function DeleteItem(ByVal ItemName As String) As Long
        Dim rItem As clsItem = ItemStatList(GetItemIndex(ItemName))
        Dim Index As Integer = FindItemInBag(ItemName)
        If Index = -1 Then Return -1
        If Not BagItems(Index) Is Nothing Then
            Dim ItemID As Long = BagItems(FindItemInBag(ItemName)).ItemID
            Weight -= rItem.Weight

            PlayerItemList.Remove(BagItems(FindItemInBag(ItemName)).ItemID)
            BagItems(FindItemInBag(ItemName)) = Nothing
            Return ItemID
        Else
            Return -1
        End If
    End Function

    Public Function DeleteItem(ByVal ItemID As Long) As Long
        Dim Index As Integer = FindItemInBag(ItemID)
        If Index = -1 Then Return -1
        If Not BagItems(Index) Is Nothing Then
            Dim rItem As clsItem = ItemStatList(BagItems(Index).ItemIndex)
            Weight -= rItem.Weight

            PlayerItemList.Remove(BagItems(Index).ItemID)
            BagItems(Index) = Nothing
            Return ItemID
        Else
            Return -1
        End If
    End Function

#End Region
#Region "PutOnItem"

    Public Function PutOnItem(ByVal Item As clsPlayerItem, ByVal Slot As EquipType) As Byte
        Dim rItem As clsItem = ItemStatList(Item.ItemIndex)
        Dim ErrCode As Byte
        RemoveItemFromBag(Item)

        ErrCode = CanItemBeWorn(rItem, Slot)
        If ErrCode <> 0 Then
            Return ErrCode
        End If

        Item.Character = Name
        Item.Type = Slot
        Equipment(Slot) = Item
        AddItemStats(Item)
        PlayerItemList.Add(Item.ItemID, Item)
        Return 0
    End Function

#End Region
#Region "TakeOffItem"

    Public Function TakeOffItem(ByVal Item As clsPlayerItem) As Byte
        Dim rItem As clsItem = ItemStatList(Item.ItemIndex)
        Dim Slot As EquipType = FindItemInEquipment(Item.ItemID)
        '#######CHECK ITEM CAN BE TAKEN OFF######'
        If Slot = -1 Then
            Return 1
        End If
        '########################################'
        RemoveItemStats(Item)
        Equipment(Slot) = Nothing
        PlayerItemList.Remove(Item.ItemID)

        AddItemToBag(Item)
        Return 0
    End Function

#End Region
#Region "UseItem"

    Public Function UseItem(ByVal ItemID As Long) As Boolean
        Dim bSlot As Integer = Me.FindItemInBag(ItemID)

        If bSlot <> -1 Then
            'Item exists in players bag
            Dim rItem As clsItem = ItemStatList(Me.BagItems(bSlot).ItemIndex)

            Select Case rItem.Type
                Case ItemType.Book
                    'Learn Spell

                    Me.DeleteItem(ItemID)
                    Packets.SendDeleteItem(StateId, ItemID)
                    Return True
                Case ItemType.Potion
                    'Use Potion
                    Select Case rItem.Type2
                        Case Potions.Normal
                        Case Potions.Instant
                        Case Potions.Luck
                        Case Potions.Stats
                        Case Potions.Repair
                        Case Potions.SpecialRepair
                    End Select

                    Me.DeleteItem(ItemID)
                    Packets.SendDeleteItem(StateId, ItemID)
                    Return True
                Case ItemType.Teleport
                    'Use Teleport
                    Select Case rItem.Type2
                        Case Teleports.DungeonEscape
                            Me.RandomMove(Me.HomeMap)
                        Case Teleports.HomeTeleport

                        Case Teleports.RandomTeleport
                            Me.RandomMove(Me.Map)
                        Case Teleports.TownTeleport
                            If CanWalk(New Point(Me.HomeX, Me.HomeY), Me.HomeMap) Then
                                Me.PositionMove(Me.HomeX, Me.HomeY, Me.HomeMap)
                            Else
                                Dim p As Point = GetRandomSpot(Me.HomeX, Me.HomeY, Me.HomeMap, 10)
                                Me.PositionMove(p.X, p.Y, Me.HomeMap)
                            End If
                    End Select

                    Me.DeleteItem(ItemID)
                    Packets.SendDeleteItem(StateId, ItemID)
                    Return True
            End Select

        End If
    End Function

#End Region
#Region "PositionMove"

    Public Sub PositionMove(ByVal tX As Short, ByVal tY As Short, Optional ByVal tMap As String = "")
        If IsDead = False Then

            If Maps.Contains(tMap) = False Then
                If tMap = "" Then
                    tMap = Map
                Else
                    Exit Sub
                End If
            End If

            Dim CheckMap As Map = Maps(tMap)
            Dim CurrentMap As Map = Maps(Map)
            If CheckMap.MapFlags(tX, tY) Then
                'If you can walk there
                Dim ii As Integer
                For ii = 0 To 9
                    If CheckMap.ObjectList.Contains(tX & "/" & tY & "/" & ii) = False Then
                        'If something already on the spot then try go on top
                        ProcessPlayerDisappear(StateId)
                        'CurrentMap.Objects.Remove(GetKeyFromValue(CurrentMap.Objects, StateId))
                        Map = tMap
                        X = tX
                        Y = tY
                        LastMove = DateTime.Now.Ticks
                        CheckMap.ObjectList.Add(X & "/" & Y & "/" & ii, StateId)
                        '####' Send Teleport '####'
                        Packets.SendTeleport(StateId, X, Y, CheckMap.LightMode, CheckMap.MapFilename, CheckMap.MapName)
                    End If
                Next ii

            End If

        End If
    End Sub

#End Region
#Region "RandomMove"

    Public Sub RandomMove(ByVal tMap As String)
        If Maps.Contains(Map) Then
            Dim tX, tY As Short
            Dim CheckMap As Map = Maps(tMap)
            Dim i As Integer
            Dim Moved As Boolean = False

            Do Until Moved Or i = 50
                tX = Rand(0, CheckMap.MapSize.Width)
                tY = Rand(0, CheckMap.MapSize.Height)
                If CheckMap.MapFlags(tX, tY) Then
                    ProcessPlayerDisappear(StateId)
                    Moved = True
                End If
                i += 1
            Loop
            X = tX
            Y = tY

            '####' Send Random Teleport '####'
            Packets.SendTeleport(StateId, X, Y, CheckMap.LightMode, CheckMap.MapFilename, CheckMap.MapName)
            Map = tMap

        End If
    End Sub

#End Region
#Region "Leveling"

    Public Sub AddExp(ByVal Amount As Long, ByVal TargetId As Object)
        If TargetId Is Nothing Then GoTo NoTIdAddEXP
        If Amount = 0 Or ObjectList(TargetId) Is Nothing Then Exit Sub
        Dim tMonster As New clsMonster
        If Not TargetId Is Nothing Then
            If ObjectList(TargetId).GetType Is tMonster.GetType Then
                tMonster = ObjectList(TargetId)
                Dim MonStats As clsMobStats = MonsterStatsList(tMonster.Name)
                If Not Me.Level < MonStats.Level + 10 Then
                    Amount = MonStats.MaxHP - Math.Round((MonStats.MaxHP / 15) * (Me.Level - (MonStats.Level + 10)))
                    If Amount < 0 Then Amount = 0
                End If
            End If
        End If
NotIdAddEXP:
        If Me.Exp + Amount >= MaxExpList(Level - 1) Then
            Me.Level += 1
            If Not TargetId Is Nothing Then
                Packets.SendExpAdd(Me.StateId, Me.Exp, Amount)
            Else
                Packets.SendExpAdd(Me.StateId, Me.Exp, -1)
            End If
            Me.Exp += Amount
            LevelUp()
            Dim LeftOverExp As Integer = Me.Exp - MaxExpList(Level - 2)
            Me.Exp = 0
            Me.AddExp(LeftOverExp, Nothing)
        Else
            Me.Exp += Amount
            If Not TargetId Is Nothing Then
                Packets.SendExpAdd(Me.StateId, Me.Exp, Amount)
            Else
                Packets.SendExpAdd(Me.StateId, Me.Exp, -1)
            End If
        End If
    End Sub

    Private Sub LeveledUp()
        Dim Locals As Hashtable = GetLocalPlayers(Me.X, Me.Y, Me.Map, 15, 15)
        Dim lPlayer As clsPlayer
        Dim i As Integer

        For i = 0 To Locals.Count - 1
            If Not Locals(i) Is Nothing Then
                'Tell players
                lPlayer = ObjectList(Locals(i))
                Packets.SendLevelUp(lPlayer.StateId, Me.StateId, Me.Level, Races.Player, Me.Exp, Me.MaxExp)
            End If
        Next i
    End Sub

    Public Sub LevelUp()
        'Update stats
        If Level > 50 Then
            Me.MaxExp = MaxExpList(50)
        Else
            Me.MaxExp = MaxExpList(Level - 1)
        End If

        UpdatePlayerStats()

        Me.HP = Me.MaxHP
        Me.MP = Me.MaxMP

        Packets.SendPlayerStats(Me.StateId, Me.Gold, Me.Job, GetPlayerStats(Me))
        LeveledUp()
    End Sub

#End Region

#End Region

#Region "GetAttackMode"

    Public Function GetAttackMode() As String
        If Me.AttackMode = AttackModes.Peaceful Then
            Return "[Peace attack mode]"
        ElseIf Me.AttackMode = AttackModes.GroupAttack Then
            Return "[Group attack mode]"
        ElseIf Me.AttackMode = AttackModes.GuildAttack Then
            Return "[Guild attack mode]"
        ElseIf Me.AttackMode = AttackModes.RedBrownAttack Then
            Return "[Red & brown mode]"
        ElseIf Me.AttackMode = AttackModes.MarriageAttack Then
            Return "[Marriage mode]"
        Else
            Return "[Attack all mode]"
        End If
    End Function

#End Region
#Region "GetPlayerValues"

    Private Sub GetPlayerValues()
        Try
            Dim DR As System.Data.SqlClient.SqlDataReader
            Dim StrSql As String = "Select * From TBL_Chars where (Character = '" & Me.Name & "')"
            Dim SqlComm As New System.Data.SqlClient.SqlCommand(StrSql, SqlConnAcc)
            DR = SqlComm.ExecuteReader

            If DR.HasRows Then
                DR.Read()
                Me.Level = DR.Item("Level")
                Me.Job = DR.Item("Class")
                Me.Gender = DR.Item("Gender")
                Me.Hair = DR.Item("Hair")
                If Me.Level > 0 Then 'Not New Character
                    Me.Map = Trim(DR.Item("Map"))
                    Me.X = DR.Item("X")
                    Me.Y = DR.Item("Y")
                    Me.Dir = DR.Item("Dir")
                    Me.HomeMap = Trim(DR.Item("HomeMap"))
                    Me.HomeX = DR.Item("HomeX")
                    Me.HomeY = DR.Item("HomeY")
                    Me.HP = DR.Item("HP")
                    Me.MP = DR.Item("MP")
                    Me.Exp = DR.Item("CurrentEXP")
                    Me.PKPoint = DR.Item("PKPoint")
                    Me.AllowGroup = DR.Item("AllowGroup")
                    Me.AttackMode = DR.Item("AttackMode")
                    Me.AllowGroupRecall = DR.Item("AllowGroupRecall")
                    'Me.BodyLuck = DR.Item("BodyLuck")
                    Me.IncHealth = DR.Item("IncHealth")
                    Me.IncMana = DR.Item("IncMana")
                    Me.IncHealing = DR.Item("IncHealing")
                    Me.GuildName = GetGuildName(Me.Name)
                    Me.GuildTitle = GetGuildTitle(Me.Name)
                    Me.GuildRank = GetGuildRank(Me.Name)
                End If