modmainserver.vb.svn-base

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

                                'Remove Monster
                                'MonsterList.Remove(tMonster.MobId)
                                ObjectList.Remove(tMonster.MobId)
                            Else
                                Select Case MagicAttack.EffectType
                                    'If the spell is a spell that actually strikes a player
                                    Case MagEffectTypes.ShootDamage, MagEffectTypes.NearShootSquare2x2, MagEffectTypes.NearShootSquare4x4, MagEffectTypes.NearShootSquare6x6, MagEffectTypes.NearShootSquare8x8
                                        Packets.SendStruck(lPlayer.StateId, TargetRace, GetSmallMonsterBuffer(tMonster))
                                End Select
                            End If

                        Case Races.Player
                            tPlayer = ObjectList(TargetId)
                            If tPlayer.IsDead Then
                                'If player died tell everyone
                                Packets.SendDied(lPlayer.StateId, tPlayer.StateId, TargetRace)
                                'Do Drops
                            Else
                                Select Case MagicAttack.EffectType
                                    'If the spell is a spell that actually strikes a player
                                    Case MagEffectTypes.ShootDamage, MagEffectTypes.NearShootSquare2x2, MagEffectTypes.NearShootSquare4x4, MagEffectTypes.NearShootSquare6x6, MagEffectTypes.NearShootSquare8x8
                                        Packets.SendStruck(lPlayer.StateId, TargetRace, GetSmallPlayerBuffer(tPlayer))
                                End Select
                            End If
                    End Select

                End If
            Next i

        End While

    End Sub

#End Region

#Region "ProcessWearItem"

    Public Sub ProcessWearItem(ByVal Header As Header, ByVal State As State)
        Dim Player As clsPlayer = ObjectList(State.Index)
        Dim ItemID As Long = Header.nRecog
        Dim pItem As clsPlayerItem = PlayerItemList(ItemID)
        Dim Slot As EquipType = Header.wParam

        If Not pItem Is Nothing Then
            Dim ErrCode As Byte
            ErrCode = Player.PutOnItem(pItem, Slot)
            Select Case ErrCode
                Case 0 'No Errors
                    Packets.SendWearItemOK(State.Index, pItem.ItemID)
                    Packets.SendPlayerStats(State.Index, Player.Gold, Player.Job, GetPlayerStats(Player))
                    Dim Locals As Hashtable = GetLocalObjects(Player.X, Player.Y, Player.Map, 15, 15, -1)
                    Dim Added As New Hashtable
                    Dim tPlayer As clsPlayer
                    Dim tPlayerID As Integer

                    Dim i As Integer
                    For i = 0 To Locals.Count - 1
                        tPlayerID = Locals(i)
                        tPlayer = ObjectList(tPlayerID)
                        If Not Added.Contains(tPlayerID) And Not tPlayer Is Nothing And Not tPlayerID = Player.StateId Then
                            Packets.SendPlayerLookChanged(tPlayer.StateId, Player.StateId, GetPlayerLooks(Player))
                            Packets.SendPlayerStatsChanged(tPlayer.StateId, GetSmallPlayerBuffer(Player))
                            Added.add(tPlayerID, "")
                        End If
                    Next i
                Case 1 'Need more stats
                    Packets.SendWearItemFail(State.Index, ErrCode)
            End Select
        Else
            Packets.SendWearItemFail(State.Index, 2)
        End If
    End Sub

#End Region
#Region "ProcessTakeOffItem"

    Public Sub ProcessTakeOffItem(ByVal Header As Header, ByVal State As State)
        Dim Player As clsPlayer = ObjectList(State.Index)
        Dim ItemID As Long = Header.nRecog
        Dim pItem As clsPlayerItem = PlayerItemList(ItemID)

        If Not pItem Is Nothing Then
            Dim ErrCode As Byte
            ErrCode = Player.TakeOffItem(pItem)
            Select Case ErrCode
                Case 0 'No Errors
                    Packets.SendTakeOffItemOK(State.Index, pItem.ItemID)
                    Packets.SendPlayerStats(State.Index, Player.Gold, Player.Job, GetPlayerStats(Player))
                    Dim Locals As Hashtable = GetLocalObjects(Player.X, Player.Y, Player.Map, 15, 15, Player.StateId)
                    Dim Added As New Hashtable
                    Dim tPlayer As clsPlayer
                    Dim tPlayerID As Integer

                    Dim i As Integer
                    For i = 0 To Locals.Count - 1
                        tPlayerID = Locals(i)
                        tPlayer = ObjectList(tPlayerID)
                        If Not Added.Contains(tPlayerID) And Not tPlayer Is Nothing And Not tPlayerID = Player.StateId Then
                            Packets.SendPlayerLookChanged(tPlayer.StateId, Player.StateId, GetPlayerLooks(Player))
                            Packets.SendPlayerStatsChanged(tPlayer.StateId, GetSmallPlayerBuffer(Player))
                            Added.add(tPlayerID, "")
                        End If
                    Next i
            End Select
        Else
            Packets.SendTakeOffItemFail(State.Index, 2)
        End If
    End Sub

#End Region
#Region "ProcessDropItem"

    Public Sub ProcessDropItem(ByVal Header As Header, ByVal State As State)
        Dim Player As clsPlayer = ObjectList(State.Index)
        Dim ItemID As Long = Header.nRecog

        If Not Player Is Nothing And PlayerItemList.ContainsKey(ItemID) Then
            'Check the Player and the Item exist
            Player.DropItem(ItemID)
        End If
    End Sub

#End Region
#Region "ProcessPickupItem"

    Public Sub ProcessPickupItem(ByVal Header As Header, ByVal State As State)
        Dim Player As clsPlayer = ObjectList(State.Index)
        Dim ItemID As Long = Header.nRecog
        Dim Map As Map = Maps(Player.Map)

        If Not Player Is Nothing And PlayerItemList.ContainsKey(ItemID) And Map.Drops.ContainsValue(ItemID) Then
            'Check the item exists
            Dim pItem As clsPlayerItem = PlayerItemList(ItemID)
            Dim i As Integer = Player.PickupItem(ItemID)
            If i = 0 Then
                Packets.SendPickupItem(State.Index, GetItemBuffer(pItem), 1)

                Dim Locals As Hashtable = GetLocalPlayers(Player.X, Player.Y, Player.Map, 15, 15)
                Dim Added As New Hashtable
                Dim lPlayer As New clsPlayer
                Dim pID As Integer

                For i = 0 To Locals.Count - 1
                    pID = Locals(i)
                    lPlayer = ObjectList(pID)
                    If Not lPlayer Is Nothing And Not Added.Contains(pID) And Not lPlayer.StateId = Player.StateId Then
                        'Sends all the players the item has been picked up
                        Packets.SendRemoveDropItem(lPlayer.StateId, ItemID)
                        Dim sKey As Long = GetKeyFromValue(lPlayer.LocalDropItems, ItemID)
                        lPlayer.LocalDropItems.Remove(sKey)
                        Added.Add(pID, pID)
                    End If
                Next i                
            End If
        End If
    End Sub

#End Region
#Region "ProcessUseItem"

    Public Sub ProcessUseItem(ByVal Header As Header, ByVal State As State)
        Dim ItemID As Long = Header.nRecog
        Dim Player As clsPlayer = ObjectList(State.Index)
        Dim Used As Boolean = False

        If Not Player Is Nothing Then
            Used = Player.UseItem(ItemID)
        End If

        If Used Then
            Packets.SendUseItemOK(State.Index)
        Else
            Packets.SendUseItemFail(State.Index)
        End If

    End Sub

#End Region

#Region "ProcessRequestGuildInfo"

    Public Sub ProcessRequestGuildInfo(ByVal State As State)
        Dim Player As clsPlayer = ObjectList(State.Index)

        If Player.GuildName = "" Then
            'Player not in a guild
            Packets.SendGuildInfoFail(State.Index)
        Else
            Dim Guild As clsGuild = GuildList(Player.GuildName)
            Packets.SendGuildInfo(State.Index, Guild.GuildNotice, Guild.GuildMembers)
        End If
    End Sub

#End Region

#End Region

#Region "Monster Processing"

    Public Sub MonsterProcess()
        Dim en As IDictionaryEnumerator
        Dim lMonster As New clsMonster
        Dim h As Long

        Do Until 1 = 2
            en = ObjectList.GetEnumerator

            Try
                While en.MoveNext
                    If en.Value.GetType Is lMonster.GetType Then
                        'MONSTER
                        lMonster = en.Value
                        lMonster.Process()
                    End If
                End While
            Catch

            End Try

            MonsterThread.Sleep(1000)
        Loop

    End Sub

#End Region

#Region "Account Verifications"

#Region "CheckLogin"

    Private Function CheckLogin(ByVal ID As String, ByVal Password As String) As Boolean
        Dim SQlPass As String
        Dim DR As System.Data.SqlClient.SqlDataReader
        Dim strSQL As String = "SELECT Password FROM TBL_Account WHERE (Username = '" & ID & "')"
        Dim SqlComm As New System.Data.SqlClient.SqlCommand(strSQL, SqlConnAcc)
        Try
            DR = SqlComm.ExecuteReader
            Do While DR.Read()
                SQlPass = Trim(DR.Item("Password"))
            Loop
        Catch oExcept As Exception
            MessageBox.Show(oExcept.Message)
        End Try
        DR.Close()
        SqlComm.Dispose()
        DR = Nothing
        SqlComm = Nothing
        If SQlPass = Trim(Password) Then
            Return True
        Else
            Return False
        End If
    End Function

#End Region
#Region "Check Cert"

    Public Function CheckCert(ByVal Id As String, ByVal Cert As String) As Boolean
        Dim SqlCert As String = ""
        Try
            Dim Dr As System.Data.SqlClient.SqlDataReader
            Dim StrSql As String = "Select Certification From TBL_Account Where (Username = '" & Id & "')"
            Dim SqlComm As New System.Data.SqlClient.SqlCommand(StrSql, SqlConnAcc)

            Dr = SqlComm.ExecuteReader
            Do While Dr.Read()
                SqlCert = Dr.Item("Certification")
            Loop
            'close the connection
            Dr.Close()
            SqlComm.Dispose()
            Dr = Nothing
            SqlComm = Nothing
            If SqlCert = Cert Then
                Return True
            Else
                Return False
            End If
        Catch ex As Exception
            MessageBox.Show("CheckCert: " & ex.Message)
        End Try
    End Function

#End Region
#Region "CharExistOnAcc"

    Public Function CharExistOnAcc(ByVal Id As String, ByVal Charnick As String) As Boolean
        Dim Nick As String = ""
        Try
            Dim Dr As System.Data.SqlClient.SqlDataReader
            Dim StrSql As String = "Select Character From TBL_Chars Where (LoginID = '" & Id & "') and ((Deleted is Null) or (Deleted = 0))"
            Dim SqlComm As New System.Data.SqlClient.SqlCommand(StrSql, SqlConnAcc)
            Dim Output As Boolean = False
            Dr = SqlComm.ExecuteReader

            Do While Dr.Read()
                Nick = Dr.Item("Character")
                If Trim(Nick) = Charnick Then
                    Output = True
                End If
            Loop
            'close the connection
            Dr.Close()
            SqlComm.Dispose()
            Dr = Nothing
            SqlComm = Nothing
            Return Output
        Catch ex As Exception
            MessageBox.Show("CharExistOnAcc" & ex.Message)
        End Try
    End Function

#End Region

#End Region
#Region "MD5 Encoding"

    Public Function GenerateHash(ByVal SourceText As String) As String
        'Create an encoding object to ensure the encoding standard for the source text
        Dim Ue As New UnicodeEncoding
        'Retrieve a byte array based on the source text
        Dim ByteSourceText() As Byte = Ue.GetBytes(SourceText)
        'Instantiate an MD5 Provider object
        Dim Md5 As New MD5CryptoServiceProvider
        'Compute the hash value from the source
        Dim ByteHash() As Byte = Md5.ComputeHash(ByteSourceText)
        'And convert it to String format for return
        Return Convert.ToBase64String(ByteHash)
    End Function

#End Region
#Region "SQL"

#Region "ConnectSQL"

    Private Sub ConnectSQL()
        Try
            SqlConnAcc = New System.Data.SqlClient.SqlConnection("Persist Security Info=False;Data Source=" & Trim(Config.SQLIP) & ";Initial Catalog=GameAccount;User ID=" & Trim(Config.SQLLogin) & ";Password=" & Trim(Config.SQLPass) & ";")
            SqlConnAcc.Open()