[EEB] Servidor Estável

Myke ~ · 1 [EEB] Servidor Estável 6/3/2013, 22:26

Myke ~

Membro Honorário I

Mensagens : 184
<b> T$: </b>

T$: : 5075

Idade : 27

Bom, vi que essa areá estava meio parada, entao vim postar um tutorial, que eu achei aqui a muito muito tempo.

Ele serve para parar com os Erros que acontecem ao dropar algum item, spam etc...

Vai para o Source do Servidor e abra o com o visual basic 6.0

Vamos procure por Modtypes procure isso:

Código:: Function GetPlayerName(ByVal Index As Long) As String

e Um enter e Adicione isso:

Código:: On Error Resume Next

Procure isso no modGameLogic:

Código:: Case ITEM_TYPE_ARMOR If InvNum = GetPlayerArmorSlot(Index) Then Call SetPlayerArmorSlot(Index, 0) Call SendWornEquipment(Index) End If MapItem(GetPlayerMap(Index), i).Dur = GetPlayerInvItemDur(Index, InvNum) Case ITEM_TYPE_WEAPON If InvNum = GetPlayerWeaponSlot(Index) Then Call SetPlayerWeaponSlot(Index, 0) Call SendWornEquipment(Index) End If MapItem(GetPlayerMap(Index), i).Dur = GetPlayerInvItemDur(Index, InvNum) Case ITEM_TYPE_HELMET If InvNum = GetPlayerHelmetSlot(Index) Then Call SetPlayerHelmetSlot(Index, 0) Call SendWornEquipment(Index) End If MapItem(GetPlayerMap(Index), i).Dur = GetPlayerInvItemDur(Index, InvNum) Case ITEM_TYPE_SHIELD If InvNum = GetPlayerShieldSlot(Index) Then Call SetPlayerShieldSlot(Index, 0) Call SendWornEquipment(Index) End If MapItem(GetPlayerMap(Index), i).Dur = GetPlayerInvItemDur(Index, InvNum) End Select MapItem(GetPlayerMap(Index), i).num = GetPlayerInvItemNum(Index, InvNum) MapItem(GetPlayerMap(Index), i).x = GetPlayerX(Index) MapItem(GetPlayerMap(Index), i).y = GetPlayerY(Index) If Item(GetPlayerInvItemNum(Index, InvNum)).Type = ITEM_TYPE_CURRENCY Then ' Checar se há mais e então dropar If Amount >= GetPlayerInvItemValue(Index, InvNum) Then MapItem(GetPlayerMap(Index), i).Value = GetPlayerInvItemValue(Index, InvNum) Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " deixou " & GetPlayerInvItemValue(Index, InvNum) & " " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & ".", Yellow) Call SetPlayerInvItemNum(Index, InvNum, 0) Call SetPlayerInvItemValue(Index, InvNum, 0) Call SetPlayerInvItemDur(Index, InvNum, 0) Else MapItem(GetPlayerMap(Index), i).Value = Amount Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " deixou " & Amount & " " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & ".", Yellow) Call SetPlayerInvItemValue(Index, InvNum, GetPlayerInvItemValue(Index, InvNum) - Amount) End If Else ' Não é um objeto, então é fácil MapItem(GetPlayerMap(Index), i).Value = 0 If Item(GetPlayerInvItemNum(Index, InvNum)).Type >= ITEM_TYPE_WEAPON And Item(GetPlayerInvItemNum(Index, InvNum)).Type <= ITEM_TYPE_SHIELD Then If Item(GetPlayerInvItemNum(Index, InvNum)).Data1 <= -1 Then Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " deixou um(a) " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & " - Ind.", Yellow) Else If Item(GetPlayerInvItemNum(Index, InvNum)).Data1 > 0 Then Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " deixou um(a) " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & " - " & GetPlayerInvItemDur(Index, InvNum) & "/" & Item(GetPlayerInvItemNum(Index, InvNum)).Data1 & ".", Yellow) Else Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " deixou um(a) " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & " - " & GetPlayerInvItemDur(Index, InvNum) & "/" & Item(GetPlayerInvItemNum(Index, InvNum)).Data1 * -1 & ".", Yellow) End If End If Else Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " deixou um(a) " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & ".", Yellow) End If Call SetPlayerInvItemNum(Index, InvNum, 0) Call SetPlayerInvItemValue(Index, InvNum, 0) Call SetPlayerInvItemDur(Index, InvNum, 0) End If

E Substitua tudo por isso:

Código:: Case ITEM_TYPE_WEAPON If InvNum = GetPlayerWeaponSlot(Index) Then Call SetPlayerWeaponSlot(Index, 0) Call SendWornEquipment(Index) End If On Error Resume Next MapItem(GetPlayerMap(Index), i).Dur = GetPlayerInvItemDur(Index, InvNum) Case ITEM_TYPE_HELMET If InvNum = GetPlayerHelmetSlot(Index) Then Call SetPlayerHelmetSlot(Index, 0) Call SendWornEquipment(Index) End If On Error Resume Next MapItem(GetPlayerMap(Index), i).Dur = GetPlayerInvItemDur(Index, InvNum) Case ITEM_TYPE_SHIELD If InvNum = GetPlayerShieldSlot(Index) Then Call SetPlayerShieldSlot(Index, 0) Call SendWornEquipment(Index) End If On Error Resume Next MapItem(GetPlayerMap(Index), i).Dur = GetPlayerInvItemDur(Index, InvNum) End Select MapItem(GetPlayerMap(Index), i).num = GetPlayerInvItemNum(Index, InvNum) MapItem(GetPlayerMap(Index), i).x = GetPlayerX(Index) MapItem(GetPlayerMap(Index), i).y = GetPlayerY(Index) If Item(GetPlayerInvItemNum(Index, InvNum)).Type = ITEM_TYPE_CURRENCY Then On Error Resume Next ' Check if its more then they have and if so drop it all If Amount >= GetPlayerInvItemValue(Index, InvNum) Then MapItem(GetPlayerMap(Index), i).Value = GetPlayerInvItemValue(Index, InvNum) Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " drops " & GetPlayerInvItemValue(Index, InvNum) & " " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & ".", Yellow) Call SetPlayerInvItemNum(Index, InvNum, 0) Call SetPlayerInvItemValue(Index, InvNum, 0) Call SetPlayerInvItemDur(Index, InvNum, 0) Else On Error Resume Next MapItem(GetPlayerMap(Index), i).Value = Amount Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " drops " & Amount & " " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & ".", Yellow) Call SetPlayerInvItemValue(Index, InvNum, GetPlayerInvItemValue(Index, InvNum) - Amount) End If Else ' Its not a currency object so this is easy On Error Resume Next MapItem(GetPlayerMap(Index), i).Value = 0 If Item(GetPlayerInvItemNum(Index, InvNum)).Type >= ITEM_TYPE_WEAPON And Item(GetPlayerInvItemNum(Index, InvNum)).Type <= ITEM_TYPE_SHIELD Then If Item(GetPlayerInvItemNum(Index, InvNum)).Data1 <= -1 Then Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & " - Ind.", Yellow) Else On Error Resume Next If Item(GetPlayerInvItemNum(Index, InvNum)).Data1 > 0 Then Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & " - " & GetPlayerInvItemDur(Index, InvNum) & "/" & Item(GetPlayerInvItemNum(Index, InvNum)).Data1 & ".", Yellow) Else Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & " - " & GetPlayerInvItemDur(Index, InvNum) & "/" & Item(GetPlayerInvItemNum(Index, InvNum)).Data1 * -1 & ".", Yellow) End If End If Else On Error Resume Next Call MapMsg(GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & Trim$(Item(GetPlayerInvItemNum(Index, InvNum)).Name) & ".", Yellow) End If Call SetPlayerInvItemNum(Index, InvNum, 0) Call SetPlayerInvItemValue(Index, InvNum, 0) Call SetPlayerInvItemDur(Index, InvNum, 0) End If

Procure agora por isso:

Código:: Sub PlayerMapGetItem(ByVal Index As Long) Dim i As Long Dim N As Long Dim MapNum As Long Dim Msg As String If IsPlaying(Index) = False Then Exit Sub End If

De um Enter e Adicione:

Código:: On Error Resume Next

procure agora por:

Código:: If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_KILL Then

Acima disso adicione:

Código:: On Error Resume Next

Procure por isso:

Código:: Sub IncomingData(ByVal Index As Long, ByVal DataLength As Long) Dim Buffer As String Dim Packet As String Dim top As String * 3 Dim Start As Long If Index > 0 Then frmServer.Socket(Index).GetData Buffer, vbString, DataLength If Buffer = "top" Then top = STR(TotalOnlinePlayers) Call SendDataTo(Index, top) Call CloseSocket(Index) End If Player(Index).Buffer = Player(Index).Buffer & Buffer Start = InStr(Player(Index).Buffer, END_CHAR) Do While Start > 0 Packet = Mid$(Player(Index).Buffer, 1, Start - 1) Player(Index).Buffer = Mid$(Player(Index).Buffer, Start + 1, Len(Player(Index).Buffer)) Player(Index).DataPackets = Player(Index).DataPackets + 1 Start = InStr(Player(Index).Buffer, END_CHAR) If Len(Packet) > 0 Then

e Abaixo adicione:

Código:: On Error Resume Next

procure:

Código:: Sub SendDataTo(ByVal Index As Long, ByVal Data As String) If IsConnected(Index) Then

de um Enter e adicione:

Código:: On Error Resume Next

procure:

Código:: Function GetPlayerNextLevel(ByVal Index As Long) As Long GetPlayerNextLevel = Experience(GetPlayerLevel(Index)) End Function

mude para:

Código:: Function GetPlayerNextLevel(ByVal Index As Long) As Long On Error Resume Next GetPlayerNextLevel = Experience(GetPlayerLevel(Index)) End Function

procure:

Código:: Sub SetPlayerX(ByVal Index As Long, ByVal x As Long) Player(Index).Char(Player(Index).CharNum).x = x End Sub

mude:

Código:: Sub SetPlayerX(ByVal Index As Long, ByVal x As Long) On Error Resume Next Player(Index).Char(Player(Index).CharNum).x = x End Sub

procure:

Código:: Sub SetPlayerY(ByVal Index As Long, ByVal y As Long) Player(Index).Char(Player(Index).CharNum).y = y End Sub

mude:

Código:: Sub SetPlayerY(ByVal Index As Long, ByVal y As Long) On Error Resume Next Player(Index).Char(Player(Index).CharNum).y = y End Sub

procure por isso no sub: GetPlayerNextLevel

Código:: Function GetPlayerNextLevel(ByVal Index As Long) As Long GetPlayerNextLevel = Experience(GetPlayerLevel(Index)) End Function

mude:

Código:: Function GetPlayerNextLevel(ByVal Index As Long) As Long On Error GoTo Erro_no_level GetPlayerNextLevel = Experience(GetPlayerLevel(Index)) Erro_no_level: If Err.Number = 9 Then Resume Next End If End Function

procure:

Código:: Sub AddToGrid(ByVal NewMap, _ ByVal NewX, _ ByVal NewY) Grid(NewMap).Loc(NewX, NewY).Blocked = True End Sub

mude:

Código:: Sub AddToGrid(ByVal NewMap, _ ByVal NewX, _ ByVal NewY) On Error GoTo erro_no_grid Grid(NewMap).Loc(NewX, NewY).Blocked = True erro_no_grid: If Err.Number = 9 Then Resume Next End If End Sub

procure:

Código:: ' Check if they have enough MP If GetPlayerMP(Index) < Spell(SpellNum).MPCost Then Call BattleMsg(Index, "Sem mana para usar a magia!", BrightRed, 0) Exit Sub End If

mude:

Código:: ' Check if they have enough MP On Error GoTo Erro_no_mp If GetPlayerMP(Index) < Spell(SpellNum).MPCost Then Call BattleMsg(Index, "Not enough mana!", BrightRed, 0) Exit Sub End If Erro_no_mp: If Err.Number = 9 Then Resume Next End If

procure:

Código:: Function GetSpellReqLevel(ByVal SpellNum As Long) GetSpellReqLevel = Spell(SpellNum).LevelReq ' - Int(GetClassMAGI(GetPlayerClass(index)) / 4) End Function

mude:

Código:: Function GetSpellReqLevel(ByVal SpellNum As Long) On Error GoTo erro_spell GetSpellReqLevel = Spell(SpellNum).LevelReq ' - Int(GetClassMAGI(GetPlayerClass(index)) / 4) erro_spell: If Err.Number = 9 Then Resume Next End If End Function

procure:

Código:: ' Spawn the item before we set the num or we'll get a different free map item slot Call SpawnItemSlot(i, MapItem(GetPlayerMap(Index), i).num, Amount, MapItem(GetPlayerMap(Index), i).Dur, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index)) Else Call PlayerMsg(Index, "Já há muitos itens no chão.", BrightRed) End If End If End Sub

mude:

Código:: Spawn the item before we set the num or we'll get a different free map item slot On Error GoTo erro_slot Call SpawnItemSlot(i, MapItem(GetPlayerMap(Index), i).num, Amount, MapItem(GetPlayerMap(Index), i).Dur, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index)) Else Call PlayerMsg(Index, "To many items already on the ground.", BrightRed) End If End If erro_slot: If Err.Number = 9 Then Resume Next End If End Sub

Creditos ~
Desconhecido

1 [EEB] Servidor Estável 6/3/2013, 22:26

Myke ~