Show Protocol.bas syntax highlighted
Attribute VB_Name = "Protocol"
'**************************************************************
' Protocol.bas - Handles all incoming / outgoing messages for client-server communications.
' Uses a binary protocol designed by myself.
'
' Designed and implemented by Juan Martín Sotuyo Dodero (Maraxus)
' (juansotuyo@gmail.com)
'**************************************************************
'**************************************************************************
'This program is free software; you can redistribute it and/or modify
'it under the terms of the Affero General Public License;
'either version 1 of the License, or any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'Affero General Public License for more details.
'
'You should have received a copy of the Affero General Public License
'along with this program; if not, you can find it at http://www.affero.org/oagpl.html
'**************************************************************************
''
'Handles all incoming / outgoing packets for client - server communications
'The binary prtocol here used was designed by Juan Martín Sotuyo Dodero.
'This is the first time it's used in Alkon, though the second time it's coded.
'This implementation has several enhacements from the first design.
'
' @file Protocol.bas
' @author Juan Martín Sotuyo Dodero (Maraxus) juansotuyo@gmail.com
' @version 1.0.0
' @date 20060517
Option Explicit
''
' TODO : /BANIP y /UNBANIP ya no trabajan con nicks. Esto lo puede mentir en forma local el cliente con un paquete a NickToIp
''
'When we have a list of strings, we use this to separate them and prevent
'having too many string lengths in the queue. Yes, each string is NULL-terminated :P
Private Const SEPARATOR As String * 1 = vbNullChar
Private Type tFont
red As Byte
green As Byte
blue As Byte
bold As Boolean
italic As Boolean
End Type
Private Enum ServerPacketID
logged ' LOGGED
RemoveDialogs ' QTDL
RemoveCharDialog ' QDL
NavigateToggle ' NAVEG
Disconnect ' FINOK
CommerceEnd ' FINCOMOK
BankEnd ' FINBANOK
CommerceInit ' INITCOM
BankInit ' INITBANCO
UserCommerceInit ' INITCOMUSU
UserCommerceEnd ' FINCOMUSUOK
ShowBlacksmithForm ' SFH
ShowCarpenterForm ' SFC
NPCSwing ' N1
NPCKillUser ' 6
BlockedWithShieldUser ' 7
BlockedWithShieldOther ' 8
UserSwing ' U1
UpdateNeeded ' REAU
SafeModeOn ' SEGON
SafeModeOff ' SEGOFF
NobilityLost ' PN
CantUseWhileMeditating ' M!
UpdateSta ' ASS
UpdateMana ' ASM
UpdateHP ' ASH
UpdateGold ' ASG
UpdateExp ' ASE
ChangeMap ' CM
PosUpdate ' PU
NPCHitUser ' N2
UserHitNPC ' U2
UserAttackedSwing ' U3
UserHittedByUser ' N4
UserHittedUser ' N5
ChatOverHead ' ||
ConsoleMsg ' || - Beware!! its the same as above, but it was properly splitted
GuildChat ' |+
ShowMessageBox ' !!
UserIndexInServer ' IU
UserCharIndexInServer ' IP
CharacterCreate ' CC
CharacterRemove ' BP
CharacterMove ' MP, +, * and _ '
CharacterChange ' CP
ObjectCreate ' HO
ObjectDelete ' BO
BlockPosition ' BQ
PlayMIDI ' TM
PlayWave ' TW
guildList ' GL
PlayFireSound ' FO
AreaChanged ' CA
PauseToggle ' BKW
RainToggle ' LLU
CreateFX ' CFX
UpdateUserStats ' EST
WorkRequestTarget ' T01
ChangeInventorySlot ' CSI
ChangeBankSlot ' SBO
ChangeSpellSlot ' SHS
Atributes ' ATR
BlacksmithWeapons ' LAH
BlacksmithArmors ' LAR
CarpenterObjects ' OBR
RestOK ' DOK
ErrorMsg ' ERR
Blind ' CEGU
Dumb ' DUMB
ShowSignal ' MCAR
ChangeNPCInventorySlot ' NPCI
UpdateHungerAndThirst ' EHYS
Fame ' FAMA
MiniStats ' MEST
LevelUp ' SUNI
AddForumMsg ' FMSG
ShowForumForm ' MFOR
SetInvisible ' NOVER
DiceRoll ' DADOS
MeditateToggle ' MEDOK
BlindNoMore ' NSEGUE
DumbNoMore ' NESTUP
SendSkills ' SKILLS
TrainerCreatureList ' LSTCRI
guildNews ' GUILDNE
OfferDetails ' PEACEDE & ALLIEDE
AlianceProposalsList ' ALLIEPR
PeaceProposalsList ' PEACEPR
CharacterInfo ' CHRINFO
GuildLeaderInfo ' LEADERI
GuildDetails ' CLANDET
ShowGuildFundationForm ' SHOWFUN
ParalizeOK ' PARADOK
ShowUserRequest ' PETICIO
TradeOK ' TRANSOK
BankOK ' BANCOOK
ChangeUserTradeSlot ' COMUSUINV
SendNight ' NOC
Pong
UpdateTagAndStatus
'GM messages
SpawnList ' SPL
ShowSOSForm ' MSOS
ShowMOTDEditionForm ' ZMOTD
ShowGMPanelForm ' ABPANEL
UserNameList ' LISTUSU
End Enum
Private Enum ClientPacketID
LoginExistingChar 'OLOGIN
ThrowDices 'TIRDAD
LoginNewChar 'NLOGIN
Talk ';
Yell '-
Whisper '\
Walk 'M
RequestPositionUpdate 'RPU
Attack 'AT
PickUp 'AG
CombatModeToggle 'TAB - SHOULD BE HANLDED JUST BY THE CLIENT!!
SafeToggle '/SEG & SEG (SEG's behaviour has to be coded in the client)
RequestGuildLeaderInfo 'GLINFO
RequestAtributes 'ATR
RequestFame 'FAMA
RequestSkills 'ESKI
RequestMiniStats 'FEST
CommerceEnd 'FINCOM
UserCommerceEnd 'FINCOMUSU
BankEnd 'FINBAN
UserCommerceOk 'COMUSUOK
UserCommerceReject 'COMUSUNO
Drop 'TI
CastSpell 'LH
LeftClick 'LC
DoubleClick 'RC
Work 'UK
UseSpellMacro 'UMH
UseItem 'USA
CraftBlacksmith 'CNS
CraftCarpenter 'CNC
WorkLeftClick 'WLC
CreateNewGuild 'CIG
SpellInfo 'INFS
EquipItem 'EQUI
ChangeHeading 'CHEA
ModifySkills 'SKSE
Train 'ENTR
CommerceBuy 'COMP
BankExtractItem 'RETI
CommerceSell 'VEND
BankDeposit 'DEPO
ForumPost 'DEMSG
MoveSpell 'DESPHE
ClanCodexUpdate 'DESCOD
UserCommerceOffer 'OFRECER
GuildAcceptPeace 'ACEPPEAT
GuildRejectAlliance 'RECPALIA
GuildRejectPeace 'RECPPEAT
GuildAcceptAlliance 'ACEPALIA
GuildOfferPeace 'PEACEOFF
GuildOfferAlliance 'ALLIEOFF
GuildAllianceDetails 'ALLIEDET
GuildPeaceDetails 'PEACEDET
GuildRequestJoinerInfo 'ENVCOMEN
GuildAlliancePropList 'ENVALPRO
GuildPeacePropList 'ENVPROPP
GuildDeclareWar 'DECGUERR
GuildNewWebsite 'NEWWEBSI
GuildAcceptNewMember 'ACEPTARI
GuildRejectNewMember 'RECHAZAR
GuildKickMember 'ECHARCLA
GuildUpdateNews 'ACTGNEWS
GuildMemberInfo '1HRINFO<
GuildOpenElections 'ABREELEC
GuildRequestMembership 'SOLICITUD
GuildRequestDetails 'CLANDETAILS
Online '/ONLINE
Quit '/SALIR
GuildLeave '/SALIRCLAN
RequestAccountState '/BALANCE
PetStand '/QUIETO
PetFollow '/ACOMPAÑAR
TrainList '/ENTRENAR
Rest '/DESCANSAR
Meditate '/MEDITAR
Resucitate '/RESUCITAR
Heal '/CURAR
Help '/AYUDA
RequestStats '/EST
CommerceStart '/COMERCIAR
BankStart '/BOVEDA
Enlist '/ENLISTAR
Information '/INFORMACION
Reward '/RECOMPENSA
RequestMOTD '/MOTD
Uptime '/UPTIME
PartyLeave '/SALIRPARTY
PartyCreate '/CREARPARTY
PartyJoin '/PARTY
Inquiry '/ENCUESTA ( with no params )
GuildMessage '/CMSG
PartyMessage '/PMSG
CentinelReport '/CENTINELA
GuildOnline '/ONLINECLAN
PartyOnline '/ONLINEPARTY
CouncilMessage '/BMSG
RoleMasterRequest '/ROL
GMRequest '/GM
bugReport '/_BUG
ChangeDescription '/DESC
GuildVote '/VOTO
Punishments '/PENAS
ChangePassword '/PASSWD
Gamble '/APOSTAR
InquiryVote '/ENCUESTA ( with parameters )
LeaveFaction '/RETIRAR ( with no arguments )
BankExtractGold '/RETIRAR ( with arguments )
BankDepositGold '/DEPOSITAR
Denounce '/DENUNCIAR
GuildFundate '/FUNDARCLAN
PartyKick '/ECHARPARTY
PartySetLeader '/PARTYLIDER
PartyAcceptMember '/ACCEPTPARTY
Ping '/PING
'GM messages
GMMessage '/GMSG
showName '/SHOWNAME
OnlineRoyalArmy '/ONLINEREAL
OnlineChaosLegion '/ONLINECAOS
GoNearby '/IRCERCA
comment '/REM
serverTime '/HORA
Where '/DONDE
CreaturesInMap '/NENE
WarpMeToTarget '/TELEPLOC
WarpChar '/TELEP
Silence '/SILENCIAR
SOSShowList '/SHOW SOS
SOSRemove 'SOSDONE
GoToChar '/IRA
invisible '/INVISIBLE
GMPanel '/PANELGM
RequestUserList 'LISTUSU
Working '/TRABAJANDO
Hiding '/OCULTANDO
Jail '/CARCEL
KillNPC '/RMATA
WarnUser '/ADVERTENCIA
EditChar '/MOD
RequestCharInfo '/INFO
RequestCharStats '/STAT
RequestCharGold '/BAL
RequestCharInventory '/INV
RequestCharBank '/BOV
RequestCharSkills '/SKILLS
ReviveChar '/REVIVIR
OnlineGM '/ONLINEGM
OnlineMap '/ONLINEMAP
Forgive '/PERDON
Kick '/ECHAR
Execute '/EJECUTAR
BanChar '/BAN
UnbanChar '/UNBAN
NPCFollow '/SEGUIR
SummonChar '/SUM
SpawnListRequest '/CC
SpawnCreature 'SPA
ResetNPCInventory '/RESETINV
CleanWorld '/LIMPIAR
ServerMessage '/RMSG
NickToIP '/NICK2IP
IPToNick '/IP2NICK
GuildOnlineMembers '/ONCLAN
TeleportCreate '/CT
TeleportDestroy '/DT
RainToggle '/LLUVIA
SetCharDescription '/SETDESC
ForceMIDIToMap '/FORCEMIDIMAP
ForceWAVEToMap '/FORCEWAVMAP
RoyalArmyMessage '/REALMSG
ChaosLegionMessage '/CAOSMSG
CitizenMessage '/CIUMSG
CriminalMessage '/CRIMSG
TalkAsNPC '/TALKAS
DestroyAllItemsInArea '/MASSDEST
AcceptRoyalCouncilMember '/ACEPTCONSE
AcceptChaosCouncilMember '/ACEPTCONSECAOS
ItemsInTheFloor '/PISO
MakeDumb '/ESTUPIDO
MakeDumbNoMore '/NOESTUPIDO
DumpIPTables '/DUMPSECURITY"
CouncilKick '/KICKCONSE
SetTrigger '/TRIGGER
AskTrigger '/TRIGGER with no arguments
BannedIPList '/BANIPLIST
BannedIPReload '/BANIPRELOAD
GuildMemberList '/MIEMBROSCLAN
GuildBan '/BANCLAN
BanIP '/BANIP
UnbanIP '/UNBANIP
CreateItem '/CI
DestroyItems '/DEST
ChaosLegionKick '/NOCAOS
RoyalArmyKick '/NOREAL
ForceMIDIAll '/FORCEMIDI
ForceWAVEAll '/FORCEWAV
RemovePunishment '/BORRARPENA
TileBlockedToggle '/BLOQ
KillNPCNoRespawn '/MATA
KillAllNearbyNPCs '/MASSKILL
LastIP '/LASTIP
ChangeMOTD '/MOTDCAMBIA
SetMOTD 'ZMOTD
SystemMessage '/SMSG
CreateNPC '/ACC
CreateNPCWithRespawn '/RACC
ImperialArmour '/AI1 - 4
ChaosArmour '/AC1 - 4
NavigateToggle '/NAVE
ServerOpenToUsersToggle '/HABILITAR
TurnOffServer '/APAGAR
TurnCriminal '/CONDEN
ResetFactions '/RAJAR
RemoveCharFromGuild '/RAJARCLAN
RequestCharMail '/LASTEMAIL
AlterPassword '/APASS
AlterMail '/AEMAIL
AlterName '/ANAME
ToggleCentinelActivated '/CENTINELAACTIVADO
DoBackUp '/DOBACKUP
ShowGuildMessages '/SHOWCMSG
SaveMap '/GUARDAMAPA
ChangeMapInfoPK '/MODMAPINFO PK
ChangeMapInfoBackup '/MODMAPINFO BACKUP
ChangeMapInfoRestricted '/MODMAPINFO RESTRINGIR
ChangeMapInfoNoMagic '/MODMAPINFO MAGIASINEFECTO
ChangeMapInfoNoInvi '/MODMAPINFO INVISINEFECTO
ChangeMapInfoNoResu '/MODMAPINFO RESUSINEFECTO
ChangeMapInfoLand '/MODMAPINFO TERRENO
ChangeMapInfoZone '/MODMAPINFO ZONA
SaveChars '/GRABAR
CleanSOS '/BORRAR SOS
ShowServerForm '/SHOW INT
night '/NOCHE
KickAllChars '/ECHARTODOSPJS
RequestTCPStats '/TCPESSTATS
ReloadNPCs '/RELOADNPCS
ReloadServerIni '/RELOADSINI
ReloadSpells '/RELOADHECHIZOS
ReloadObjects '/RELOADOBJ
Restart '/REINICIAR
ResetAutoUpdate '/AUTOUPDATE
ChatColor '/CHATCOLOR
Ignored '/IGNORADO
CheckSlot '/SLOT
End Enum
Public Enum FontTypeNames
FONTTYPE_TALK
FONTTYPE_FIGHT
FONTTYPE_WARNING
FONTTYPE_INFO
FONTTYPE_INFOBOLD
FONTTYPE_EJECUCION
FONTTYPE_PARTY
FONTTYPE_VENENO
FONTTYPE_GUILD
FONTTYPE_SERVER
FONTTYPE_GUILDMSG
FONTTYPE_CONSEJO
FONTTYPE_CONSEJOCAOS
FONTTYPE_CONSEJOVesA
FONTTYPE_CONSEJOCAOSVesA
FONTTYPE_CENTINELA
FONTTYPE_GMMSG
FONTTYPE_GM
FONTTYPE_CITIZEN
End Enum
Public FontTypes(18) As tFont
''
' Initializes the fonts array
Public Sub InitFonts()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
With FontTypes(FontTypeNames.FONTTYPE_TALK)
.red = 255
.green = 255
.blue = 255
End With
With FontTypes(FontTypeNames.FONTTYPE_FIGHT)
.red = 255
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_WARNING)
.red = 32
.green = 51
.blue = 223
.bold = 1
.italic = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_INFO)
.red = 65
.green = 190
.blue = 156
End With
With FontTypes(FontTypeNames.FONTTYPE_INFOBOLD)
.red = 65
.green = 190
.blue = 156
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_EJECUCION)
.red = 130
.green = 130
.blue = 130
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_PARTY)
.red = 255
.green = 180
.blue = 250
End With
FontTypes(FontTypeNames.FONTTYPE_VENENO).green = 255
With FontTypes(FontTypeNames.FONTTYPE_GUILD)
.red = 255
.green = 255
.blue = 255
.bold = 1
End With
FontTypes(FontTypeNames.FONTTYPE_SERVER).green = 185
With FontTypes(FontTypeNames.FONTTYPE_GUILDMSG)
.red = 228
.green = 199
.blue = 27
End With
With FontTypes(FontTypeNames.FONTTYPE_CONSEJO)
.red = 130
.green = 130
.blue = 255
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_CONSEJOCAOS)
.red = 255
.green = 60
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_CONSEJOVesA)
.green = 200
.blue = 255
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_CONSEJOCAOSVesA)
.red = 255
.green = 50
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_CENTINELA)
.green = 255
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_GMMSG)
.red = 255
.green = 255
.blue = 255
.italic = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_GM)
.green = 185
.bold = 1
End With
With FontTypes(FontTypeNames.FONTTYPE_CITIZEN)
.blue = 200
.bold = 1
End With
End Sub
''
' Handles incoming data.
Public Sub HandleIncomingData()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
On Error Resume Next
Select Case incomingData.PeekByte()
Case ServerPacketID.logged ' LOGGED
Call HandleLogged
Case ServerPacketID.RemoveDialogs ' QTDL
Call HandleRemoveDialogs
Case ServerPacketID.RemoveCharDialog ' QDL
Call HandleRemoveCharDialog
Case ServerPacketID.NavigateToggle ' NAVEG
Call HandleNavigateToggle
Case ServerPacketID.Disconnect ' FINOK
Call HandleDisconnect
Case ServerPacketID.CommerceEnd ' FINCOMOK
Call HandleCommerceEnd
Case ServerPacketID.BankEnd ' FINBANOK
Call HandleBankEnd
Case ServerPacketID.CommerceInit ' INITCOM
Call HandleCommerceInit
Case ServerPacketID.BankInit ' INITBANCO
Call HandleBankInit
Case ServerPacketID.UserCommerceInit ' INITCOMUSU
Call HandleUserCommerceInit
Case ServerPacketID.UserCommerceEnd ' FINCOMUSUOK
Call HandleUserCommerceEnd
Case ServerPacketID.ShowBlacksmithForm ' SFH
Call HandleShowBlacksmithForm
Case ServerPacketID.ShowCarpenterForm ' SFC
Call HandleShowCarpenterForm
Case ServerPacketID.NPCSwing ' N1
Call HandleNPCSwing
Case ServerPacketID.NPCKillUser ' 6
Call HandleNPCKillUser
Case ServerPacketID.BlockedWithShieldUser ' 7
Call HandleBlockedWithShieldUser
Case ServerPacketID.BlockedWithShieldOther ' 8
Call HandleBlockedWithShieldOther
Case ServerPacketID.UserSwing ' U1
Call HandleUserSwing
Case ServerPacketID.UpdateNeeded ' REAU
Call HandleUpdateNeeded
Case ServerPacketID.SafeModeOn ' SEGON
Call HandleSafeModeOn
Case ServerPacketID.SafeModeOff ' SEGOFF
Call HandleSafeModeOff
Case ServerPacketID.NobilityLost ' PN
Call HandleNobilityLost
Case ServerPacketID.CantUseWhileMeditating ' M!
Call HandleCantUseWhileMeditating
Case ServerPacketID.UpdateSta ' ASS
Call HandleUpdateSta
Case ServerPacketID.UpdateMana ' ASM
Call HandleUpdateMana
Case ServerPacketID.UpdateHP ' ASH
Call HandleUpdateHP
Case ServerPacketID.UpdateGold ' ASG
Call HandleUpdateGold
Case ServerPacketID.UpdateExp ' ASE
Call HandleUpdateExp
Case ServerPacketID.ChangeMap ' CM
Call HandleChangeMap
Case ServerPacketID.PosUpdate ' PU
Call HandlePosUpdate
Case ServerPacketID.NPCHitUser ' N2
Call HandleNPCHitUser
Case ServerPacketID.UserHitNPC ' U2
Call HandleUserHitNPC
Case ServerPacketID.UserAttackedSwing ' U3
Call HandleUserAttackedSwing
Case ServerPacketID.UserHittedByUser ' N4
Call HandleUserHittedByUser
Case ServerPacketID.UserHittedUser ' N5
Call HandleUserHittedUser
Case ServerPacketID.ChatOverHead ' ||
Call HandleChatOverHead
Case ServerPacketID.ConsoleMsg ' || - Beware!! its the same as above, but it was properly splitted
Call HandleConsoleMessage
Case ServerPacketID.GuildChat ' |+
Call HandleGuildChat
Case ServerPacketID.ShowMessageBox ' !!
Call HandleShowMessageBox
Case ServerPacketID.UserIndexInServer ' IU
Call HandleUserIndexInServer
Case ServerPacketID.UserCharIndexInServer ' IP
Call HandleUserCharIndexInServer
Case ServerPacketID.CharacterCreate ' CC
Call HandleCharacterCreate
Case ServerPacketID.CharacterRemove ' BP
Call HandleCharacterRemove
Case ServerPacketID.CharacterMove ' MP, +, * and _ '
Call HandleCharacterMove
Case ServerPacketID.CharacterChange ' CP
Call HandleCharacterChange
Case ServerPacketID.ObjectCreate ' HO
Call HandleObjectCreate
Case ServerPacketID.ObjectDelete ' BO
Call HandleObjectDelete
Case ServerPacketID.BlockPosition ' BQ
Call HandleBlockPosition
Case ServerPacketID.PlayMIDI ' TM
Call HandlePlayMIDI
Case ServerPacketID.PlayWave ' TW
Call HandlePlayWave
Case ServerPacketID.guildList ' GL
Call HandleGuildList
Case ServerPacketID.PlayFireSound ' FO
Call HandlePlayFireSound
Case ServerPacketID.AreaChanged ' CA
Call HandleAreaChanged
Case ServerPacketID.PauseToggle ' BKW
Call HandlePauseToggle
Case ServerPacketID.RainToggle ' LLU
Call HandleRainToggle
Case ServerPacketID.CreateFX ' CFX
Call HandleCreateFX
Case ServerPacketID.UpdateUserStats ' EST
Call HandleUpdateUserStats
Case ServerPacketID.WorkRequestTarget ' T01
Call HandleWorkRequestTarget
Case ServerPacketID.ChangeInventorySlot ' CSI
Call HandleChangeInventorySlot
Case ServerPacketID.ChangeBankSlot ' SBO
Call HandleChangeBankSlot
Case ServerPacketID.ChangeSpellSlot ' SHS
Call HandleChangeSpellSlot
Case ServerPacketID.Atributes ' ATR
Call HandleAtributes
Case ServerPacketID.BlacksmithWeapons ' LAH
Call HandleBlacksmithWeapons
Case ServerPacketID.BlacksmithArmors ' LAR
Call HandleBlacksmithArmors
Case ServerPacketID.CarpenterObjects ' OBR
Call HandleCarpenterObjects
Case ServerPacketID.RestOK ' DOK
Call HandleRestOK
Case ServerPacketID.ErrorMsg ' ERR
Call HandleErrorMessage
Case ServerPacketID.Blind ' CEGU
Call HandleBlind
Case ServerPacketID.Dumb ' DUMB
Call HandleDumb
Case ServerPacketID.ShowSignal ' MCAR
Call HandleShowSignal
Case ServerPacketID.ChangeNPCInventorySlot ' NPCI
Call HandleChangeNPCInventorySlot
Case ServerPacketID.UpdateHungerAndThirst ' EHYS
Call HandleUpdateHungerAndThirst
Case ServerPacketID.Fame ' FAMA
Call HandleFame
Case ServerPacketID.MiniStats ' MEST
Call HandleMiniStats
Case ServerPacketID.LevelUp ' SUNI
Call HandleLevelUp
Case ServerPacketID.AddForumMsg ' FMSG
Call HandleAddForumMessage
Case ServerPacketID.ShowForumForm ' MFOR
Call HandleShowForumForm
Case ServerPacketID.SetInvisible ' NOVER
Call HandleSetInvisible
Case ServerPacketID.DiceRoll ' DADOS
Call HandleDiceRoll
Case ServerPacketID.MeditateToggle ' MEDOK
Call HandleMeditateToggle
Case ServerPacketID.BlindNoMore ' NSEGUE
Call HandleBlindNoMore
Case ServerPacketID.DumbNoMore ' NESTUP
Call HandleDumbNoMore
Case ServerPacketID.SendSkills ' SKILLS
Call HandleSendSkills
Case ServerPacketID.TrainerCreatureList ' LSTCRI
Call HandleTrainerCreatureList
Case ServerPacketID.guildNews ' GUILDNE
Call HandleGuildNews
Case ServerPacketID.OfferDetails ' PEACEDE and ALLIEDE
Call HandleOfferDetails
Case ServerPacketID.AlianceProposalsList ' ALLIEPR
Call HandleAlianceProposalsList
Case ServerPacketID.PeaceProposalsList ' PEACEPR
Call HandlePeaceProposalsList
Case ServerPacketID.CharacterInfo ' CHRINFO
Call HandleCharacterInfo
Case ServerPacketID.GuildLeaderInfo ' LEADERI
Call HandleGuildLeaderInfo
Case ServerPacketID.GuildDetails ' CLANDET
Call HandleGuildDetails
Case ServerPacketID.ShowGuildFundationForm ' SHOWFUN
Call HandleShowGuildFundationForm
Case ServerPacketID.ParalizeOK ' PARADOK
Call HandleParalizeOK
Case ServerPacketID.ShowUserRequest ' PETICIO
Call HandleShowUserRequest
Case ServerPacketID.TradeOK ' TRANSOK
Call HandleTradeOK
Case ServerPacketID.BankOK ' BANCOOK
Call HandleBankOK
Case ServerPacketID.ChangeUserTradeSlot ' COMUSUINV
Call HandleChangeUserTradeSlot
Case ServerPacketID.SendNight ' NOC
Call HandleSendNight
Case ServerPacketID.Pong
Call HandlePong
Case ServerPacketID.UpdateTagAndStatus
Call HandleUpdateTagAndStatus
'*******************
'GM messages
'*******************
Case ServerPacketID.SpawnList ' SPL
Call HandleSpawnList
Case ServerPacketID.ShowSOSForm ' RSOS and MSOS
Call HandleShowSOSForm
Case ServerPacketID.ShowMOTDEditionForm ' ZMOTD
Call HandleShowMOTDEditionForm
Case ServerPacketID.ShowGMPanelForm ' ABPANEL
Call HandleShowGMPanelForm
Case ServerPacketID.UserNameList ' LISTUSU
Call HandleUserNameList
#If SeguridadAlkon Then
Case Else
Call HandleIncomingDataEx
#Else
Case Else
'ERROR : Abort!
Exit Sub
#End If
End Select
'Done with this packet, move on to next one
If incomingData.length > 0 And Err.Number <> incomingData.NotEnoughDataErrCode Then
Err.Clear
Call HandleIncomingData
End If
End Sub
''
' Handles the Logged message.
Private Sub HandleLogged()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
' Variable initialization
UserCiego = False
EngineRun = True
IScombate = False
UserDescansar = False
Nombres = True
'Set connected state
Call SetConnected
'Show tip
If tipf = "1" And PrimeraVez Then
Call CargarTip
frmtip.Visible = True
PrimeraVez = False
End If
End Sub
''
' Handles the RemoveDialogs message.
Private Sub HandleRemoveDialogs()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call Dialogos.RemoveAllDialogs
End Sub
''
' Handles the RemoveCharDialog message.
Private Sub HandleRemoveCharDialog()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Check if the packet is complete
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Call Dialogos.RemoveDialog(incomingData.ReadInteger())
End Sub
''
' Handles the NavigateToggle message.
Private Sub HandleNavigateToggle()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserNavegando = Not UserNavegando
End Sub
''
' Handles the Disconnect message.
Private Sub HandleDisconnect()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
Dim i As Long
'Remove packet ID
Call incomingData.ReadByte
'Close connection
#If UsarWrench = 1 Then
frmMain.Socket1.Disconnect
#Else
If frmMain.Winsock1.State <> sckClosed Then _
frmMain.Winsock1.Close
#End If
'Hide main form
frmMain.Visible = False
frmMain.Label1.Visible = False
'Stop audio
Call Audio.StopWave
frmMain.IsPlaying = PlayLoop.plNone
'Show connection form
frmConnect.Visible = True
'Reset global vars
UserParalizado = False
IScombate = False
pausa = False
UserMeditar = False
UserDescansar = False
UserNavegando = False
bRain = False
bFogata = False
SkillPoints = 0
'Delete all kind of dialogs
Call CleanDialogs
'Reset some char variables...
For i = 1 To LastChar
charlist(i).invisible = False
Next i
'Unload all forms except frmMain and frmConnect
Dim frm As Form
For Each frm In Forms
If frm.Name <> frmMain.Name And frm.Name <> frmConnect.Name Then
Unload frm
End If
Next
#If SeguridadAlkon Then
Call MI(CualMI).Inicializar(RandomNumber(1, 1000), 10000)
#End If
End Sub
''
' Handles the CommerceEnd message.
Private Sub HandleCommerceEnd()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
'Clear item's list
frmComerciar.List1(0).Clear
frmComerciar.List1(1).Clear
'Reset vars
NPCInvDim = 0
Comerciando = False
'Hide form
Unload frmComerciar
End Sub
''
' Handles the BankEnd message.
Private Sub HandleBankEnd()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
frmBancoObj.List1(0).Clear
frmBancoObj.List1(1).Clear
NPCInvDim = 0
Unload frmBancoObj
Comerciando = False
End Sub
''
' Handles the CommerceInit message.
Private Sub HandleCommerceInit()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
Dim i As Long
'Remove packet ID
Call incomingData.ReadByte
'Fill our inventory list
For i = 1 To MAX_INVENTORY_SLOTS
If Inventario.OBJIndex(i) <> 0 Then
frmComerciar.List1(1).AddItem Inventario.ItemName(i)
Else
frmComerciar.List1(1).AddItem ""
End If
Next i
'Set state and show form
Comerciando = True
frmComerciar.Show , frmMain
End Sub
''
' Handles the BankInit message.
Private Sub HandleBankInit()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
Dim i As Long
'Remove packet ID
Call incomingData.ReadByte
'Fill the inventory list
For i = 1 To MAX_INVENTORY_SLOTS
If Inventario.OBJIndex(i) <> 0 Then
frmBancoObj.List1(1).AddItem Inventario.ItemName(i)
Else
frmBancoObj.List1(1).AddItem ""
End If
Next i
'Fill the bank list
For i = 1 To MAX_BANCOINVENTORY_SLOTS
If UserBancoInventory(i).OBJIndex <> 0 Then
frmBancoObj.List1(0).AddItem UserBancoInventory(i).Name
Else
frmBancoObj.List1(0).AddItem ""
End If
Next i
'Set state and show form
Comerciando = True
frmBancoObj.Show , frmMain
End Sub
''
' Handles the UserCommerceInit message.
Private Sub HandleUserCommerceInit()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
Dim i As Long
'Remove packet ID
Call incomingData.ReadByte
'Clears lists if necessary
If frmComerciarUsu.List1.ListCount > 0 Then frmComerciarUsu.List1.Clear
If frmComerciarUsu.List2.ListCount > 0 Then frmComerciarUsu.List2.Clear
'Fill inventory list
For i = 1 To MAX_INVENTORY_SLOTS
If Inventario.OBJIndex(i) <> 0 Then
frmComerciarUsu.List1.AddItem Inventario.ItemName(i)
frmComerciarUsu.List1.ItemData(frmComerciarUsu.List1.NewIndex) = Inventario.Amount(i)
Else
frmComerciarUsu.List1.AddItem ""
frmComerciarUsu.List1.ItemData(frmComerciarUsu.List1.NewIndex) = 0
End If
Next i
'Set state and show form
Comerciando = True
frmComerciarUsu.Show , frmMain
End Sub
''
' Handles the UserCommerceEnd message.
Private Sub HandleUserCommerceEnd()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
'Clear the lists
frmComerciarUsu.List1.Clear
frmComerciarUsu.List2.Clear
'Destroy the form and reset the state
Unload frmComerciarUsu
Comerciando = False
End Sub
''
' Handles the ShowBlacksmithForm message.
Private Sub HandleShowBlacksmithForm()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
If frmMain.macrotrabajo.Enabled And (MacroBltIndex > 0) Then
Call WriteCraftBlacksmith(MacroBltIndex)
Else
frmHerrero.Show , frmMain
End If
End Sub
''
' Handles the ShowCarpenterForm message.
Private Sub HandleShowCarpenterForm()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
If frmMain.macrotrabajo.Enabled And (MacroBltIndex > 0) Then
Call WriteCraftCarpenter(MacroBltIndex)
Else
frmCarp.Show , frmMain
End If
End Sub
''
' Handles the NPCSwing message.
Private Sub HandleNPCSwing()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_CRIATURA_FALLA_GOLPE, 255, 0, 0, True, False, False)
End Sub
''
' Handles the NPCKillUser message.
Private Sub HandleNPCKillUser()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_CRIATURA_MATADO, 255, 0, 0, True, False, False)
End Sub
''
' Handles the BlockedWithShieldUser message.
Private Sub HandleBlockedWithShieldUser()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_RECHAZO_ATAQUE_ESCUDO, 255, 0, 0, True, False, False)
End Sub
''
' Handles the BlockedWithShieldOther message.
Private Sub HandleBlockedWithShieldOther()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_USUARIO_RECHAZO_ATAQUE_ESCUDO, 255, 0, 0, True, False, False)
End Sub
''
' Handles the UserSwing message.
Private Sub HandleUserSwing()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_FALLADO_GOLPE, 255, 0, 0, True, False, False)
End Sub
''
' Handles the UpdateNeeded message.
Private Sub HandleUpdateNeeded()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call frmMain.DibujarSatelite
End Sub
''
' Handles the SafeModeOn message.
Private Sub HandleSafeModeOn()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call frmMain.DibujarSeguro
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_SEGURO_ACTIVADO, 0, 255, 0, True, False, False)
End Sub
''
' Handles the SafeModeOff message.
Private Sub HandleSafeModeOff()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call frmMain.DesDibujarSeguro
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_SEGURO_DESACTIVADO, 255, 0, 0, True, False, False)
End Sub
''
' Handles the NobilityLost message.
Private Sub HandleNobilityLost()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_PIERDE_NOBLEZA, 255, 0, 0, False, False, False)
End Sub
''
' Handles the CantUseWhileMeditating message.
Private Sub HandleCantUseWhileMeditating()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_USAR_MEDITANDO, 255, 0, 0, False, False, False)
End Sub
''
' Handles the UpdateSta message.
Private Sub HandleUpdateSta()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Check packet is complete
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
'Get data and update form
UserMinSTA = incomingData.ReadInteger()
frmMain.STAShp.Width = (((UserMinSTA / 100) / (UserMaxSTA / 100)) * 94)
End Sub
''
' Handles the UpdateMana message.
Private Sub HandleUpdateMana()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Check packet is complete
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
'Get data and update form
UserMinMAN = incomingData.ReadInteger()
If UserMaxMAN > 0 Then
frmMain.MANShp.Width = (((UserMinMAN + 1 / 100) / (UserMaxMAN + 1 / 100)) * 94)
Else
frmMain.MANShp.Width = 0
End If
End Sub
''
' Handles the UpdateHP message.
Private Sub HandleUpdateHP()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Check packet is complete
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
'Get data and update form
UserMinHP = incomingData.ReadInteger()
frmMain.Hpshp.Width = (((UserMinHP / 100) / (UserMaxHP / 100)) * 94)
'Is the user alive??
If UserMinHP = 0 Then
UserEstado = 1
Else
UserEstado = 0
End If
End Sub
''
' Handles the UpdateGold message.
Private Sub HandleUpdateGold()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Check packet is complete
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
'Get data and update form
UserGLD = incomingData.ReadLong()
frmMain.GldLbl.Caption = UserGLD
End Sub
''
' Handles the UpdateExp message.
Private Sub HandleUpdateExp()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Check packet is complete
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
'Get data and update form
UserExp = incomingData.ReadLong()
frmMain.exp.Caption = "Exp: " & UserExp & "/" & UserPasarNivel
frmMain.lblPorcLvl.Caption = "[" & Round(CDbl(UserExp) * CDbl(100) / CDbl(UserPasarNivel), 2) & "%]"
End Sub
''
' Handles the ChangeMap message.
Private Sub HandleChangeMap()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
UserMap = incomingData.ReadInteger()
'TODO: Once on-the-fly editor is implemented check for map version before loading....
'For now we just drop it
Call incomingData.ReadInteger
#If SeguridadAlkon Then
Call InitMI
#End If
If FileExist(DirMapas & "Mapa" & UserMap & ".map", vbNormal) Then
Call SwitchMap(UserMap)
If bLluvia(UserMap) = 0 Then
If bRain Then
Call Audio.StopWave(RainBufferIndex)
RainBufferIndex = 0
frmMain.IsPlaying = PlayLoop.plNone
End If
End If
Else
'no encontramos el mapa en el hd
MsgBox "Error en los mapas, algún archivo ha sido modificado o esta dañado."
Call LiberarObjetosDX
Call UnloadAllForms
Call EscribirGameIni(Config_Inicio)
End
End If
End Sub
''
' Handles the PosUpdate message.
Private Sub HandlePosUpdate()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
'Remove char from old position
If MapData(UserPos.x, UserPos.y).charIndex = UserCharIndex Then
MapData(UserPos.x, UserPos.y).charIndex = 0
End If
'Set new pos
UserPos.x = incomingData.ReadByte()
UserPos.y = incomingData.ReadByte()
'Set char
MapData(UserPos.x, UserPos.y).charIndex = UserCharIndex
charlist(UserCharIndex).Pos = UserPos
'Are we under a roof?
bTecho = IIf(MapData(UserPos.x, UserPos.y).Trigger = 1 Or _
MapData(UserPos.x, UserPos.y).Trigger = 2 Or _
MapData(UserPos.x, UserPos.y).Trigger = 4, True, False)
'Update pos label
frmMain.Coord.Caption = "(" & UserMap & "," & UserPos.x & "," & UserPos.y & ")"
End Sub
''
' Handles the NPCHitUser message.
Private Sub HandleNPCHitUser()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 4 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Select Case incomingData.ReadByte()
Case bCabeza
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_GOLPE_CABEZA & CStr(incomingData.ReadInteger()), 255, 0, 0, True, False, False)
Case bBrazoIzquierdo
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_GOLPE_BRAZO_IZQ & CStr(incomingData.ReadInteger()), 255, 0, 0, True, False, False)
Case bBrazoDerecho
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_GOLPE_BRAZO_DER & CStr(incomingData.ReadInteger()), 255, 0, 0, True, False, False)
Case bPiernaIzquierda
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_GOLPE_PIERNA_IZQ & CStr(incomingData.ReadInteger()), 255, 0, 0, True, False, False)
Case bPiernaDerecha
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_GOLPE_PIERNA_DER & CStr(incomingData.ReadInteger()), 255, 0, 0, True, False, False)
Case bTorso
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_GOLPE_TORSO & CStr(incomingData.ReadInteger()), 255, 0, 0, True, False, False)
End Select
End Sub
''
' Handles the UserHitNPC message.
Private Sub HandleUserHitNPC()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_GOLPE_CRIATURA_1 & CStr(incomingData.ReadLong()) & MENSAJE_2, 255, 0, 0, True, False, False)
End Sub
''
' Handles the UserAttackedSwing message.
Private Sub HandleUserAttackedSwing()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_1 & charlist(incomingData.ReadInteger()).Nombre & MENSAJE_ATAQUE_FALLO, 255, 0, 0, True, False, False)
End Sub
''
' Handles the UserHittingByUser message.
Private Sub HandleUserHittedByUser()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 6 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim attacker As String
attacker = charlist(incomingData.ReadInteger()).Nombre
Select Case incomingData.ReadByte
Case bCabeza
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_1 & attacker & MENSAJE_RECIVE_IMPACTO_CABEZA & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bBrazoIzquierdo
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_1 & attacker & MENSAJE_RECIVE_IMPACTO_BRAZO_IZQ & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bBrazoDerecho
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_1 & attacker & MENSAJE_RECIVE_IMPACTO_BRAZO_DER & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bPiernaIzquierda
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_1 & attacker & MENSAJE_RECIVE_IMPACTO_PIERNA_IZQ & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bPiernaDerecha
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_1 & attacker & MENSAJE_RECIVE_IMPACTO_PIERNA_DER & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bTorso
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_1 & attacker & MENSAJE_RECIVE_IMPACTO_TORSO & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
End Select
End Sub
''
' Handles the UserHittedUser message.
Private Sub HandleUserHittedUser()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 6 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim victim As String
victim = charlist(incomingData.ReadInteger()).Nombre
Select Case incomingData.ReadByte
Case bCabeza
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_PRODUCE_IMPACTO_1 & victim & MENSAJE_PRODUCE_IMPACTO_CABEZA & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bBrazoIzquierdo
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_PRODUCE_IMPACTO_1 & victim & MENSAJE_PRODUCE_IMPACTO_BRAZO_IZQ & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bBrazoDerecho
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_PRODUCE_IMPACTO_1 & victim & MENSAJE_PRODUCE_IMPACTO_BRAZO_DER & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bPiernaIzquierda
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_PRODUCE_IMPACTO_1 & victim & MENSAJE_PRODUCE_IMPACTO_PIERNA_IZQ & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bPiernaDerecha
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_PRODUCE_IMPACTO_1 & victim & MENSAJE_PRODUCE_IMPACTO_PIERNA_DER & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
Case bTorso
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_PRODUCE_IMPACTO_1 & victim & MENSAJE_PRODUCE_IMPACTO_TORSO & CStr(incomingData.ReadInteger() & MENSAJE_2), 255, 0, 0, True, False, False)
End Select
End Sub
''
' Handles the ChatOverHead message.
Private Sub HandleChatOverHead()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 8 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim chat As String
Dim charIndex As Integer
Dim r As Byte
Dim g As Byte
Dim b As Byte
chat = Buffer.ReadASCIIString()
charIndex = Buffer.ReadInteger()
r = Buffer.ReadByte()
g = Buffer.ReadByte()
b = Buffer.ReadByte()
'Only add the chat if the character exists (a CharacterRemove may have been sent to the PC / NPC area before the buffer was flushed)
If charlist(charIndex).Active Then _
Call Dialogos.CreateDialog(chat, charIndex, RGB(r, g, b))
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the ConsoleMessage message.
Private Sub HandleConsoleMessage()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 4 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim chat As String
Dim fontIndex As Integer
chat = Buffer.ReadASCIIString()
fontIndex = Buffer.ReadByte()
If InStr(1, chat, "~") Then
Call AddtoRichTextBox(frmMain.RecTxt, Left$(chat, InStr(1, chat, "~") - 1), Val(ReadField(2, chat, 126)), Val(ReadField(3, chat, 126)), Val(ReadField(4, chat, 126)), Val(ReadField(5, chat, 126)), Val(ReadField(6, chat, 126)))
Else
With FontTypes(fontIndex)
Call AddtoRichTextBox(frmMain.RecTxt, chat, .red, .green, .blue, .bold, .italic)
End With
End If
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the GuildChat message.
Private Sub HandleGuildChat()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim chat As String
chat = Buffer.ReadASCIIString()
If Not DialogosClanes.Activo Then
If InStr(1, chat, "~") Then
Call AddtoRichTextBox(frmMain.RecTxt, Left$(chat, InStr(1, chat, "~") - 1), Val(ReadField(2, chat, 126)), Val(ReadField(3, chat, 126)), Val(ReadField(4, chat, 126)), Val(ReadField(5, chat, 126)), Val(ReadField(6, chat, 126)))
Else
With FontTypes(FontTypeNames.FONTTYPE_GUILDMSG)
Call AddtoRichTextBox(frmMain.RecTxt, chat, .red, .green, .blue, .bold, .italic)
End With
End If
Else
Call DialogosClanes.PushBackText(ReadField(1, chat, 126))
End If
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the ShowMessageBox message.
Private Sub HandleShowMessageBox()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
frmMensaje.msg.Caption = Buffer.ReadASCIIString()
frmMensaje.Show
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the UserIndexInServer message.
Private Sub HandleUserIndexInServer()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
UserIndex = incomingData.ReadInteger()
End Sub
''
' Handles the UserCharIndexInServer message.
Private Sub HandleUserCharIndexInServer()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
UserCharIndex = incomingData.ReadInteger()
UserPos = charlist(UserCharIndex).Pos
'Are we under a roof?
bTecho = IIf(MapData(UserPos.x, UserPos.y).Trigger = 1 Or _
MapData(UserPos.x, UserPos.y).Trigger = 2 Or _
MapData(UserPos.x, UserPos.y).Trigger = 4, True, False)
frmMain.Coord.Caption = "(" & UserMap & "," & UserPos.x & "," & UserPos.y & ")"
End Sub
''
' Handles the CharacterCreate message.
Private Sub HandleCharacterCreate()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 24 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim charIndex As Integer
Dim Body As Integer
Dim Head As Integer
Dim Heading As E_Heading
Dim x As Byte
Dim y As Byte
Dim weapon As Integer
Dim shield As Integer
Dim helmet As Integer
Dim privs As Integer
charIndex = Buffer.ReadInteger()
Body = Buffer.ReadInteger()
Head = Buffer.ReadInteger()
Heading = Buffer.ReadByte()
x = Buffer.ReadByte()
y = Buffer.ReadByte()
weapon = Buffer.ReadInteger()
shield = Buffer.ReadInteger()
helmet = Buffer.ReadInteger()
With charlist(charIndex)
.fX = Buffer.ReadInteger()
.FxLoopTimes = Buffer.ReadInteger()
.Nombre = Buffer.ReadASCIIString()
.Criminal = Buffer.ReadByte()
privs = Buffer.ReadByte()
If privs <> 0 Then
'If the player belongs to a council AND is an admin, only whos as an admin
If (privs And PlayerType.ChaosCouncil) <> 0 And (privs Xor PlayerType.ChaosCouncil) <> 0 Then
privs = privs Xor PlayerType.ChaosCouncil
End If
If (privs And PlayerType.RoyalCouncil) <> 0 And (privs Xor PlayerType.RoyalCouncil) <> 0 Then
privs = privs Xor PlayerType.RoyalCouncil
End If
'If the player is a RM, ignore other flags
If privs And PlayerType.RoleMaster Then
privs = PlayerType.RoleMaster
End If
'Log2 of the bit flags sent by the server gives our numbers ^^
.priv = Log(privs) / Log(2)
Else
.priv = 0
End If
End With
Call MakeChar(charIndex, Body, Head, Heading, x, y, weapon, shield, helmet)
Call RefreshAllChars
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the CharacterRemove message.
Private Sub HandleCharacterRemove()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim charIndex As Integer
charIndex = incomingData.ReadInteger()
Call EraseChar(charIndex)
Call RefreshAllChars
End Sub
''
' Handles the CharacterMove message.
Private Sub HandleCharacterMove()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim charIndex As Integer
Dim x As Byte
Dim y As Byte
charIndex = incomingData.ReadInteger()
x = incomingData.ReadByte()
y = incomingData.ReadByte()
With charlist(charIndex)
If .fX >= 40 And .fX <= 49 Then 'If it's meditating, we remove the FX
.fX = 0
.FxLoopTimes = 0
End If
' Play steps sounds if the user is not an admin of any kind
If .priv <> 1 And .priv <> 2 And .priv <> 3 And .priv <> 5 And .priv <> 25 Then
Call DoPasosFx(charIndex)
End If
End With
Call MoveCharbyPos(charIndex, x, y)
Call RefreshAllChars
End Sub
''
' Handles the CharacterChange message.
Private Sub HandleCharacterChange()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 18 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim charIndex As Integer
Dim tempint As Integer
Dim headIndex As Integer
charIndex = incomingData.ReadInteger()
With charlist(charIndex)
tempint = incomingData.ReadInteger()
If tempint < LBound(BodyData()) Or tempint > UBound(BodyData()) Then
.Body = BodyData(0)
Else
.Body = BodyData(tempint)
End If
headIndex = incomingData.ReadInteger()
If tempint < LBound(HeadData()) Or tempint > UBound(HeadData()) Then
.Head = HeadData(0)
Else
.Head = HeadData(headIndex)
End If
.muerto = (headIndex = CASPER_HEAD)
.Heading = incomingData.ReadByte()
tempint = incomingData.ReadInteger()
If tempint <> 0 Then .Arma = WeaponAnimData(tempint)
tempint = incomingData.ReadInteger()
If tempint <> 0 Then .Escudo = ShieldAnimData(tempint)
tempint = incomingData.ReadInteger()
If tempint <> 0 Then .Casco = CascoAnimData(tempint)
.fX = incomingData.ReadInteger()
.FxLoopTimes = incomingData.ReadInteger()
End With
Call RefreshAllChars
End Sub
''
' Handles the ObjectCreate message.
Private Sub HandleObjectCreate()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim x As Byte
Dim y As Byte
x = incomingData.ReadByte()
y = incomingData.ReadByte()
MapData(x, y).ObjGrh.GrhIndex = incomingData.ReadInteger()
Call InitGrh(MapData(x, y).ObjGrh, MapData(x, y).ObjGrh.GrhIndex)
End Sub
''
' Handles the ObjectDelete message.
Private Sub HandleObjectDelete()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim x As Byte
Dim y As Byte
x = incomingData.ReadByte()
y = incomingData.ReadByte()
MapData(x, y).ObjGrh.GrhIndex = 0
End Sub
''
' Handles the BlockPosition message.
Private Sub HandleBlockPosition()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 4 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim x As Byte
Dim y As Byte
x = incomingData.ReadByte()
y = incomingData.ReadByte()
If incomingData.ReadBoolean() Then
MapData(x, y).Blocked = 1
Else
MapData(x, y).Blocked = 0
End If
End Sub
''
' Handles the PlayMIDI message.
Private Sub HandlePlayMIDI()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 4 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
Dim currentMidi As Byte
'Remove packet ID
Call incomingData.ReadByte
currentMidi = incomingData.ReadByte()
If currentMidi Then
Call Audio.PlayMIDI(CStr(currentMidi) & ".mid", incomingData.ReadInteger())
Else
'Remove the bytes to prevent errors
Call incomingData.ReadInteger
End If
End Sub
''
' Handles the PlayWave message.
Private Sub HandlePlayWave()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 08/08/07
'Last Modified by: Rapsodius
'Added support for 3D Sounds.
'***************************************************
If incomingData.length < 6 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Call Audio.PlayWave(CStr(incomingData.ReadByte()) & ".wav", incomingData.ReadInteger(), incomingData.ReadInteger())
End Sub
''
' Handles the GuildList message.
Private Sub HandleGuildList()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
'Clear guild's list
frmGuildAdm.guildslist.Clear
Dim guilds() As String
guilds = Split(Buffer.ReadASCIIString(), SEPARATOR)
Dim i As Long
For i = 0 To UBound(guilds())
Call frmGuildAdm.guildslist.AddItem(guilds(i))
Next i
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
frmGuildAdm.Show vbModeless, frmMain
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the PlayFireSound message.
Private Sub HandlePlayFireSound()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
If FogataBufferIndex = 0 Then
FogataBufferIndex = Audio.PlayWave("fuego.wav", -8, -8, LoopStyle.Enabled)
End If
End Sub
''
' Handles the AreaChanged message.
Private Sub HandleAreaChanged()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim x As Byte
Dim y As Byte
x = incomingData.ReadByte()
y = incomingData.ReadByte()
Call CambioDeArea(x, y)
End Sub
''
' Handles the PauseToggle message.
Private Sub HandlePauseToggle()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
pausa = Not pausa
End Sub
''
' Handles the RainToggle message.
Private Sub HandleRainToggle()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
If Not InMapBounds(UserPos.x, UserPos.y) Then Exit Sub
bTecho = (MapData(UserPos.x, UserPos.y).Trigger = 1 Or _
MapData(UserPos.x, UserPos.y).Trigger = 2 Or _
MapData(UserPos.x, UserPos.y).Trigger = 4)
If bRain Then
If bLluvia(UserMap) Then
'Stop playing the rain sound
Call Audio.StopWave(RainBufferIndex)
RainBufferIndex = 0
If bTecho Then
Call Audio.PlayWave("lluviainend.wav", -8, -8, LoopStyle.Disabled)
Else
Call Audio.PlayWave("lluviaoutend.wav", -8, -8, LoopStyle.Disabled)
End If
frmMain.IsPlaying = PlayLoop.plNone
End If
End If
bRain = Not bRain
End Sub
''
' Handles the CreateFX message.
Private Sub HandleCreateFX()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 7 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim charIndex As Integer
charIndex = incomingData.ReadInteger()
charlist(charIndex).fX = incomingData.ReadInteger()
charlist(charIndex).FxLoopTimes = incomingData.ReadInteger()
End Sub
''
' Handles the UpdateUserStats message.
Private Sub HandleUpdateUserStats()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 26 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
UserMaxHP = incomingData.ReadInteger()
UserMinHP = incomingData.ReadInteger()
UserMaxMAN = incomingData.ReadInteger()
UserMinMAN = incomingData.ReadInteger()
UserMaxSTA = incomingData.ReadInteger()
UserMinSTA = incomingData.ReadInteger()
UserGLD = incomingData.ReadLong()
UserLvl = incomingData.ReadByte()
UserPasarNivel = incomingData.ReadLong()
UserExp = incomingData.ReadLong()
frmMain.exp.Caption = "Exp: " & UserExp & "/" & UserPasarNivel
If UserPasarNivel > 0 Then
frmMain.lblPorcLvl.Caption = "[" & Round(CDbl(UserExp) * CDbl(100) / CDbl(UserPasarNivel), 2) & "%]"
Else
frmMain.lblPorcLvl.Caption = "[N/A]"
End If
frmMain.Hpshp.Width = (((UserMinHP / 100) / (UserMaxHP / 100)) * 94)
If UserMaxMAN > 0 Then
frmMain.MANShp.Width = (((UserMinMAN + 1 / 100) / (UserMaxMAN + 1 / 100)) * 94)
Else
frmMain.MANShp.Width = 0
End If
frmMain.STAShp.Width = (((UserMinSTA / 100) / (UserMaxSTA / 100)) * 94)
frmMain.GldLbl.Caption = UserGLD
frmMain.LvlLbl.Caption = UserLvl
If UserMinHP = 0 Then
UserEstado = 1
Else
UserEstado = 0
End If
End Sub
''
' Handles the WorkRequestTarget message.
Private Sub HandleWorkRequestTarget()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 2 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
UsingSkill = incomingData.ReadByte()
frmMain.MousePointer = 2
Select Case UsingSkill
Case Magia
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_MAGIA, 100, 100, 120, 0, 0)
Case Pesca
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_PESCA, 100, 100, 120, 0, 0)
Case Robar
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_ROBAR, 100, 100, 120, 0, 0)
Case Talar
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_TALAR, 100, 100, 120, 0, 0)
Case Mineria
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_MINERIA, 100, 100, 120, 0, 0)
Case FundirMetal
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_FUNDIRMETAL, 100, 100, 120, 0, 0)
Case Proyectiles
Call AddtoRichTextBox(frmMain.RecTxt, MENSAJE_TRABAJO_PROYECTILES, 100, 100, 120, 0, 0)
End Select
End Sub
''
' Handles the ChangeInventorySlot message.
Private Sub HandleChangeInventorySlot()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 22 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim slot As Byte
Dim OBJIndex As Integer
Dim Name As String
Dim Amount As Integer
Dim Equipped As Boolean
Dim GrhIndex As Integer
Dim OBJType As Byte
Dim MaxHit As Integer
Dim MinHit As Integer
Dim defense As Integer
Dim value As Long
slot = Buffer.ReadByte()
OBJIndex = Buffer.ReadInteger()
Name = Buffer.ReadASCIIString()
Amount = Buffer.ReadInteger()
Equipped = Buffer.ReadBoolean()
GrhIndex = Buffer.ReadInteger()
OBJType = Buffer.ReadByte()
MaxHit = Buffer.ReadInteger()
MinHit = Buffer.ReadInteger()
defense = Buffer.ReadInteger()
value = Buffer.ReadLong()
Call Inventario.SetItem(slot, OBJIndex, Amount, Equipped, GrhIndex, OBJType, MaxHit, MinHit, defense, value, Name)
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the ChangeBankSlot message.
Private Sub HandleChangeBankSlot()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 21 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim slot As Byte
slot = Buffer.ReadByte()
With UserBancoInventory(slot)
.OBJIndex = Buffer.ReadInteger()
.Name = Buffer.ReadASCIIString()
.Amount = Buffer.ReadInteger()
.GrhIndex = Buffer.ReadInteger()
.OBJType = Buffer.ReadByte()
.MaxHit = Buffer.ReadInteger()
.MinHit = Buffer.ReadInteger()
.Def = Buffer.ReadInteger()
.Valor = Buffer.ReadLong()
End With
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the ChangeSpellSlot message.
Private Sub HandleChangeSpellSlot()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 6 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim slot As Byte
slot = Buffer.ReadByte()
UserHechizos(slot) = Buffer.ReadInteger()
If slot <= frmMain.hlst.ListCount Then
frmMain.hlst.List(slot - 1) = Buffer.ReadASCIIString()
Else
Call frmMain.hlst.AddItem(Buffer.ReadASCIIString())
End If
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the Attributes message.
Private Sub HandleAtributes()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 1 + NUMATRIBUTES Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim i As Long
For i = 1 To NUMATRIBUTES
UserAtributos(i) = incomingData.ReadByte()
Next i
'Show them in character creation
If EstadoLogin = E_MODO.Dados Then
With frmCrearPersonaje
If .Visible Then
.lbFuerza.Caption = UserAtributos(1)
.lbAgilidad.Caption = UserAtributos(2)
.lbInteligencia.Caption = UserAtributos(3)
.lbCarisma.Caption = UserAtributos(4)
.lbConstitucion.Caption = UserAtributos(5)
End If
End With
Else
LlegaronAtrib = True
End If
End Sub
''
' Handles the BlacksmithWeapons message.
Private Sub HandleBlacksmithWeapons()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim Count As Integer
Dim i As Long
Dim Tmp As String
Count = Buffer.ReadInteger()
For i = 1 To Count
Tmp = Buffer.ReadASCIIString() & " (" 'Get the object's name
Tmp = Tmp & CStr(Buffer.ReadInteger()) & "," 'The iron needed
Tmp = Tmp & CStr(Buffer.ReadInteger()) & "," 'The silver needed
Tmp = Tmp & CStr(Buffer.ReadInteger()) & ")" 'The gold needed
Call frmHerrero.lstArmas.AddItem(Tmp)
ArmasHerrero(i) = Buffer.ReadInteger()
Next i
For i = i To UBound(ArmasHerrero())
ArmasHerrero(i) = 0
Next i
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the BlacksmithArmors message.
Private Sub HandleBlacksmithArmors()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim Count As Integer
Dim i As Long
Dim Tmp As String
Count = Buffer.ReadInteger()
For i = 1 To Count
Tmp = Buffer.ReadASCIIString() & " (" 'Get the object's name
Tmp = Tmp & CStr(Buffer.ReadInteger()) & "," 'The iron needed
Tmp = Tmp & CStr(Buffer.ReadInteger()) & "," 'The silver needed
Tmp = Tmp & CStr(Buffer.ReadInteger()) & ")" 'The gold needed
Call frmHerrero.lstArmaduras.AddItem(Tmp)
ArmadurasHerrero(i) = Buffer.ReadInteger()
Next i
For i = i To UBound(ArmadurasHerrero())
ArmadurasHerrero(i) = 0
Next i
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the CarpenterObjects message.
Private Sub HandleCarpenterObjects()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim Count As Integer
Dim i As Long
Dim Tmp As String
Count = Buffer.ReadInteger()
Call frmCarp.lstArmas.Clear
For i = 1 To Count
Tmp = Buffer.ReadASCIIString() & " (" 'Get the object's name
Tmp = Tmp & CStr(Buffer.ReadInteger()) & ")" 'The wood needed
Call frmCarp.lstArmas.AddItem(Tmp)
ObjCarpintero(i) = Buffer.ReadInteger()
Next i
For i = i To UBound(ObjCarpintero())
ObjCarpintero(i) = 0
Next i
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the RestOK message.
Private Sub HandleRestOK()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserDescansar = Not UserDescansar
End Sub
''
' Handles the ErrorMessage message.
Private Sub HandleErrorMessage()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Call MsgBox(Buffer.ReadASCIIString())
frmOldPersonaje.MousePointer = 1
frmPasswd.MousePointer = 1
If frmOldPersonaje.Visible Then
#If UsarWrench = 1 Then
frmMain.Socket1.Disconnect
frmMain.Socket1.Cleanup
#Else
If frmMain.Winsock1.State <> sckClosed Then _
frmMain.Winsock1.Close
#End If
End If
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the Blind message.
Private Sub HandleBlind()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserCiego = True
Dim r As RECT
BackBufferSurface.BltColorFill r, 0
End Sub
''
' Handles the Dumb message.
Private Sub HandleDumb()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserEstupido = True
End Sub
''
' Handles the ShowSignal message.
Private Sub HandleShowSignal()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim Tmp As String
Tmp = Buffer.ReadASCIIString()
Call InitCartel(Tmp, Buffer.ReadInteger())
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the ChangeNPCInventorySlot message.
Private Sub HandleChangeNPCInventorySlot()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 20 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
With NPCInventory(NPCInvDim + 1)
.Name = Buffer.ReadASCIIString()
.Amount = Buffer.ReadInteger()
.Valor = Buffer.ReadLong()
.GrhIndex = Buffer.ReadInteger()
.OBJIndex = Buffer.ReadInteger()
.OBJType = Buffer.ReadByte()
.MaxHit = Buffer.ReadInteger()
.MinHit = Buffer.ReadInteger()
.Def = Buffer.ReadInteger()
End With
NPCInvDim = NPCInvDim + 1
Call frmComerciar.List1(0).AddItem(NPCInventory(NPCInvDim).Name)
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the UpdateHungerAndThirst message.
Private Sub HandleUpdateHungerAndThirst()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
UserMaxAGU = incomingData.ReadByte()
UserMinAGU = incomingData.ReadByte()
UserMaxHAM = incomingData.ReadByte()
UserMinHAM = incomingData.ReadByte()
frmMain.AGUAsp.Width = (((UserMinAGU / 100) / (UserMaxAGU / 100)) * 94)
frmMain.COMIDAsp.Width = (((UserMinHAM / 100) / (UserMaxHAM / 100)) * 94)
End Sub
''
' Handles the Fame message.
Private Sub HandleFame()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 29 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
With UserReputacion
.AsesinoRep = incomingData.ReadLong()
.BandidoRep = incomingData.ReadLong()
.BurguesRep = incomingData.ReadLong()
.LadronesRep = incomingData.ReadLong()
.NobleRep = incomingData.ReadLong()
.PlebeRep = incomingData.ReadLong()
.Promedio = incomingData.ReadLong()
End With
LlegoFama = True
End Sub
''
' Handles the MiniStats message.
Private Sub HandleMiniStats()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 20 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
With UserEstadisticas
.CiudadanosMatados = incomingData.ReadLong()
.CriminalesMatados = incomingData.ReadLong()
.UsuariosMatados = incomingData.ReadLong()
.NpcsMatados = incomingData.ReadInteger()
.Clase = ListaClases(incomingData.ReadByte())
.PenaCarcel = incomingData.ReadLong()
End With
End Sub
''
' Handles the LevelUp message.
Private Sub HandleLevelUp()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
SkillPoints = SkillPoints + incomingData.ReadInteger()
frmMain.Label1.Visible = True
End Sub
''
' Handles the AddForumMessage message.
Private Sub HandleAddForumMessage()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 5 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim title As String
Dim Message As String
title = Buffer.ReadASCIIString()
Message = Buffer.ReadASCIIString()
Call frmForo.List.AddItem(title)
frmForo.Text(frmForo.List.ListCount - 1).Text = Message
Call Load(frmForo.Text(frmForo.List.ListCount))
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the ShowForumForm message.
Private Sub HandleShowForumForm()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
If Not frmForo.Visible Then
frmForo.Show , frmMain
End If
End Sub
''
' Handles the SetInvisible message.
Private Sub HandleSetInvisible()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 4 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim charIndex As Integer
charIndex = incomingData.ReadInteger()
charlist(charIndex).invisible = incomingData.ReadBoolean()
#If SeguridadAlkon Then
If charlist(charIndex).invisible Then
Call MI(CualMI).SetInvisible(charIndex)
Else
Call MI(CualMI).ResetInvisible(charIndex)
End If
#End If
End Sub
''
' Handles the DiceRoll message.
Private Sub HandleDiceRoll()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 6 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
UserAtributos(eAtributos.Fuerza) = incomingData.ReadByte()
UserAtributos(eAtributos.Agilidad) = incomingData.ReadByte()
UserAtributos(eAtributos.Inteligencia) = incomingData.ReadByte()
UserAtributos(eAtributos.Carisma) = incomingData.ReadByte()
UserAtributos(eAtributos.Constitucion) = incomingData.ReadByte()
frmCrearPersonaje.lbFuerza = UserAtributos(eAtributos.Fuerza)
frmCrearPersonaje.lbAgilidad = UserAtributos(eAtributos.Agilidad)
frmCrearPersonaje.lbInteligencia = UserAtributos(eAtributos.Inteligencia)
frmCrearPersonaje.lbCarisma = UserAtributos(eAtributos.Carisma)
frmCrearPersonaje.lbConstitucion = UserAtributos(eAtributos.Constitucion)
End Sub
''
' Handles the MeditateToggle message.
Private Sub HandleMeditateToggle()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserMeditar = Not UserMeditar
End Sub
''
' Handles the BlindNoMore message.
Private Sub HandleBlindNoMore()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserCiego = False
End Sub
''
' Handles the DumbNoMore message.
Private Sub HandleDumbNoMore()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserEstupido = False
End Sub
''
' Handles the SendSkills message.
Private Sub HandleSendSkills()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 1 + NUMSKILLS Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim i As Long
For i = 1 To NUMSKILLS
UserSkills(i) = incomingData.ReadByte()
Next i
LlegaronSkills = True
End Sub
''
' Handles the TrainerCreatureList message.
Private Sub HandleTrainerCreatureList()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim creatures() As String
Dim i As Long
creatures = Split(Buffer.ReadASCIIString(), SEPARATOR)
For i = 0 To UBound(creatures())
Call frmEntrenador.lstCriaturas.AddItem(creatures(i))
Next i
frmEntrenador.Show , frmMain
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the GuildNews message.
Private Sub HandleGuildNews()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 7 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim guildList() As String
Dim i As Long
'Get news' string
frmGuildNews.news = Buffer.ReadASCIIString()
'Get Enemy guilds list
guildList = Split(Buffer.ReadASCIIString(), SEPARATOR)
For i = 0 To UBound(guildList)
Call frmGuildNews.guerra.AddItem(guildList(i))
Next i
'Get Allied guilds list
guildList = Split(Buffer.ReadASCIIString(), SEPARATOR)
For i = 0 To UBound(guildList)
Call frmGuildNews.aliados.AddItem(guildList(i))
Next i
frmGuildNews.Show vbModeless, frmMain
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the OfferDetails message.
Private Sub HandleOfferDetails()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Call frmUserRequest.recievePeticion(Buffer.ReadASCIIString())
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the AlianceProposalsList message.
Private Sub HandleAlianceProposalsList()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim guildList() As String
Dim i As Long
guildList = Split(Buffer.ReadASCIIString(), SEPARATOR)
For i = 0 To UBound(guildList())
Call frmPeaceProp.lista.AddItem(guildList(i))
Next i
frmPeaceProp.ProposalType = TIPO_PROPUESTA.ALIANZA
Call frmPeaceProp.Show(vbModeless, frmMain)
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the PeaceProposalsList message.
Private Sub HandlePeaceProposalsList()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim guildList() As String
Dim i As Long
guildList = Split(Buffer.ReadASCIIString(), SEPARATOR)
For i = 0 To UBound(guildList())
Call frmPeaceProp.lista.AddItem(guildList(i))
Next i
frmPeaceProp.ProposalType = TIPO_PROPUESTA.PAZ
Call frmPeaceProp.Show(vbModeless, frmMain)
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the CharacterInfo message.
Private Sub HandleCharacterInfo()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 35 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
With frmCharInfo
If .frmmiembros Then
.Rechazar.Visible = False
.Aceptar.Visible = False
.Echar.Visible = True
.desc.Visible = False
Else
.Rechazar.Visible = True
.Aceptar.Visible = True
.Echar.Visible = False
.desc.Visible = True
End If
.Nombre.Caption = "Nombre: " & Buffer.ReadASCIIString()
.Raza.Caption = "Raza: " & ListaRazas(Buffer.ReadByte())
.Clase.Caption = "Clase: " & ListaClases(Buffer.ReadByte())
If Buffer.ReadByte() = 1 Then
.Genero.Caption = "Genero: Hombre"
Else
.Genero.Caption = "Genero: Mujer"
End If
.Nivel.Caption = "Nivel: " & Buffer.ReadByte()
.Oro.Caption = "Oro: " & Buffer.ReadLong()
.Banco.Caption = "Banco: " & Buffer.ReadLong()
Dim reputation As Long
reputation = Buffer.ReadLong()
.reputacion.Caption = "Reputación: " & reputation
.txtPeticiones.Text = Buffer.ReadASCIIString()
.guildactual.Caption = "Clan: " & Buffer.ReadASCIIString()
.txtMiembro.Text = Buffer.ReadASCIIString()
Dim armada As Boolean
Dim caos As Boolean
armada = Buffer.ReadBoolean()
caos = Buffer.ReadBoolean()
If armada Then
.ejercito.Caption = "Ejército: Armada Real"
ElseIf caos Then
.ejercito.Caption = "Ejército: Legión Oscura"
End If
.Ciudadanos.Caption = "Ciudadanos asesinados: " & CStr(Buffer.ReadLong())
.criminales.Caption = "Criminales asesinados: " & CStr(Buffer.ReadLong())
If reputation > 0 Then
.status.Caption = " (Ciudadano)"
.status.ForeColor = vbBlue
Else
.status.Caption = " (Criminal)"
.status.ForeColor = vbRed
End If
Call .Show(vbModeless, frmMain)
End With
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the GuildLeaderInfo message.
Private Sub HandleGuildLeaderInfo()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 9 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Dim List() As String
Dim i As Long
With frmGuildLeader
'Get list of existing guilds
List = Split(Buffer.ReadASCIIString(), SEPARATOR)
'Empty the list
Call .guildslist.Clear
For i = 0 To UBound(List())
Call .guildslist.AddItem(List(i))
Next i
'Get list of guild's members
List = Split(Buffer.ReadASCIIString(), SEPARATOR)
.Miembros.Caption = "El clan cuenta con " & CStr(UBound(List()) + 1) & " miembros."
'Empty the list
Call .members.Clear
For i = 0 To UBound(List())
Call .members.AddItem(List(i))
Next i
.txtguildnews = Buffer.ReadASCIIString()
'Get list of join requests
List = Split(Buffer.ReadASCIIString(), SEPARATOR)
'Empty the list
Call .solicitudes.Clear
For i = 0 To UBound(List())
Call .solicitudes.AddItem(List(i))
Next i
.Show , frmMain
End With
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the GuildDetails message.
Private Sub HandleGuildDetails()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 26 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
With frmGuildBrief
If Not .EsLeader Then
.guerra.Visible = False
.aliado.Visible = False
.Command3.Visible = False
Else
.guerra.Visible = True
.aliado.Visible = True
.Command3.Visible = True
End If
.Nombre.Caption = "Nombre:" & Buffer.ReadASCIIString()
.fundador.Caption = "Fundador:" & Buffer.ReadASCIIString()
.creacion.Caption = "Fecha de creacion:" & Buffer.ReadASCIIString()
.lider.Caption = "Líder:" & Buffer.ReadASCIIString()
.web.Caption = "Web site:" & Buffer.ReadASCIIString()
.Miembros.Caption = "Miembros:" & Buffer.ReadInteger()
If Buffer.ReadBoolean() Then
.eleccion.Caption = "Elección de líder: ABIERTA"
Else
.eleccion.Caption = "Elección de líder: CERRADA"
End If
.lblAlineacion.Caption = "Alineación: " & Buffer.ReadASCIIString()
.Enemigos.Caption = "Clanes enemigos:" & Buffer.ReadInteger()
.aliados.Caption = "Clanes aliados:" & Buffer.ReadInteger()
.antifaccion.Caption = "Puntos Antifaccion: " & Buffer.ReadASCIIString()
Dim codexStr() As String
Dim i As Long
codexStr = Split(Buffer.ReadASCIIString(), SEPARATOR)
For i = 0 To 7
.Codex(i).Caption = codexStr(i)
Next i
.desc.Text = Buffer.ReadASCIIString()
End With
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
frmGuildBrief.Show vbModeless, frmMain
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the ShowGuildFundationForm message.
Private Sub HandleShowGuildFundationForm()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
CreandoClan = True
frmGuildFoundation.Show , frmMain
End Sub
''
' Handles the ParalizeOK message.
Private Sub HandleParalizeOK()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
UserParalizado = Not UserParalizado
End Sub
''
' Handles the ShowUserRequest message.
Private Sub HandleShowUserRequest()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
Call frmUserRequest.recievePeticion(Buffer.ReadASCIIString())
Call frmUserRequest.Show(vbModeless, frmMain)
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the TradeOK message.
Private Sub HandleTradeOK()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
If frmComerciar.Visible Then
Dim i As Long
For i = 1 To MAX_INVENTORY_SLOTS
If Inventario.OBJIndex(i) <> 0 Then
Call frmComerciar.List1(1).AddItem(Inventario.ItemName(i))
Else
Call frmComerciar.List1(1).AddItem("")
End If
Next i
'Alter order according to if we bought or sold so the labels and grh remain the same
If frmComerciar.LasActionBuy Then
frmComerciar.List1(1).listIndex = frmComerciar.LastIndex2
frmComerciar.List1(0).listIndex = frmComerciar.LastIndex1
Else
frmComerciar.List1(0).listIndex = frmComerciar.LastIndex1
frmComerciar.List1(1).listIndex = frmComerciar.LastIndex2
End If
End If
End Sub
''
' Handles the BankOK message.
Private Sub HandleBankOK()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
'Remove packet ID
Call incomingData.ReadByte
Dim i As Long
If frmBancoObj.Visible Then
For i = 1 To MAX_INVENTORY_SLOTS
If Inventario.OBJIndex(i) <> 0 Then
Call frmBancoObj.List1(1).AddItem(Inventario.ItemName(i))
Else
Call frmBancoObj.List1(1).AddItem("")
End If
Next i
For i = 1 To MAX_BANCOINVENTORY_SLOTS
If UserBancoInventory(i).OBJIndex <> 0 Then
Call frmBancoObj.List1(0).AddItem(UserBancoInventory(i).Name)
Else
Call frmBancoObj.List1(0).AddItem("")
End If
Next i
'Alter order according to if we bought or sold so the labels and grh remain the same
If frmBancoObj.LasActionBuy Then
frmBancoObj.List1(1).listIndex = frmBancoObj.LastIndex2
frmBancoObj.List1(0).listIndex = frmBancoObj.LastIndex1
Else
frmBancoObj.List1(0).listIndex = frmBancoObj.LastIndex1
frmBancoObj.List1(1).listIndex = frmBancoObj.LastIndex2
End If
End If
End Sub
''
' Handles the ChangeUserTradeSlot message.
Private Sub HandleChangeUserTradeSlot()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 22 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove packet ID
Call Buffer.ReadByte
With OtroInventario(1)
.OBJIndex = Buffer.ReadInteger()
.Name = Buffer.ReadASCIIString()
.Amount = Buffer.ReadLong()
.GrhIndex = Buffer.ReadInteger()
.OBJType = Buffer.ReadByte()
.MaxHit = Buffer.ReadInteger()
.MinHit = Buffer.ReadInteger()
.Def = Buffer.ReadInteger()
.Valor = Buffer.ReadLong()
frmComerciarUsu.List2.Clear
Call frmComerciarUsu.List2.AddItem(.Name)
frmComerciarUsu.List2.ItemData(frmComerciarUsu.List2.NewIndex) = .Amount
frmComerciarUsu.lblEstadoResp.Visible = False
End With
'If we got here then packet is complete, copy data back to original queue
Call incomingData.CopyBuffer(Buffer)
ErrHandler:
Dim error As Long
error = Err.Number
On Error GoTo 0
'Destroy auxiliar buffer
Set Buffer = Nothing
If error <> 0 Then _
Err.Raise error
End Sub
''
' Handles the SendNight message.
Private Sub HandleSendNight()
'***************************************************
'Autor: Fredy Horacio Treboux (liquid)
'Last Modification: 01/08/07
'
'***************************************************
If incomingData.length < 2 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
'Remove packet ID
Call incomingData.ReadByte
Dim tBool As Boolean 'CHECK, este handle no hace nada con lo que recibe.. porque, ehmm.. no hay noche?.. o si?
tBool = incomingData.ReadBoolean()
End Sub
''
' Handles the SpawnList message.
Private Sub HandleSpawnList()
'***************************************************
'Autor: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If incomingData.length < 3 Then
Err.Raise incomingData.NotEnoughDataErrCode
Exit Sub
End If
On Error GoTo ErrHandler
'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
Dim Buffer As New clsByteQueue
Call Buffer.CopyBuffer(incomingData)
'Remove