?? modmainserver.vb.svn-base
字號:
'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
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)
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()
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -