[APORTE]Tirar oro de a 100k

Private Sub Command2_Click()

Por:

Private Sub Command2_Click()
If Inventario.SelectedItem = 0 Then Exit Sub

If Inventario.SelectedItem <> FLAGORO Then
Call WriteDrop(Inventario.SelectedItem, Inventario.Amount(Inventario.SelectedItem))
Unload Me
Else
If UserGLD > 100000 Then
Call WriteDrop(Inventario.SelectedItem, 100000)
Unload Me
Else
Call WriteDrop(Inventario.SelectedItem, UserGLD)
Unload Me
End If
End If

frmCantidad.Text1.Text = ""
End Sub


Ahora buscamos:

Private Sub Text1_Change()

Y lo reemplazamos todo por:

Private Sub Text1_Change()
On Error GoTo ErrHandler
If Val(Text1.Text) < 0 Then
Text1.Text = "1"
End If

If Val(Text1.Text) > UserGLD Then
Text1.Text = UserGLD
End If

Exit Sub

ErrHandler:
'If we got here the user may have pasted (Shift + Insert) a REALLY large number, causing an overflow, so we set amount back to 1
Text1.Text = "1"
End Sub

Buscan ahora:

Public Sub WriteDrop(ByVal slot As Byte, ByVal Amount As integer)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'Writes the "Drop" message to the outgoing data buffer
'***************************************************
With outgoingData
Call .WriteByte(ClientPacketID.Drop)

Call .WriteByte(slot)
Call .WriteInteger(Amount)
End With
End Sub

Y lo remplazan por:

Public Sub WriteDrop(ByVal slot As Byte, ByVal Amount As Long)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'Writes the "Drop" message to the outgoing data buffer
'***************************************************
With outgoingData
Call .WriteByte(ClientPacketID.Drop)

Call .WriteByte(slot)
Call .WriteLong(Amount)
End With
End Sub

Servidor:

Buscan el sub:

Private Sub HandleDrop(ByVal UserIndex As Integer)

Private Sub HandleDrop(ByVal UserIndex As Integer)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'
'***************************************************
If UserList(UserIndex).incomingData.length < 4 Then
Err.Raise UserList(UserIndex).incomingData.NotEnoughDataErrCode
Exit Sub
End If

Dim Slot As Byte
Dim amount As Long

With UserList(UserIndex)
'Remove packet ID
Call .incomingData.ReadByte

Slot = .incomingData.ReadByte()
amount = .incomingData.ReadLong()

'low rank admins can't drop item. Neither can the dead nor those sailing.
If .flags.Navegando = 1 Or _
.flags.Muerto = 1 Or _
((.flags.Privilegios And PlayerType.Consejero) <> 0 And (Not .flags.Privilegios And PlayerType.RoleMaster) <> 0) Then Exit Sub

'Are we dropping gold or other items??
If Slot = FLAGORO Then
If amount > 100000 Then Exit Sub 'Don't drop too much gold

Call TirarOro(amount, UserIndex)

Call WriteUpdateGold(UserIndex)
Else
'Only drop valid slots
If Slot <= MAX_INVENTORY_SLOTS And Slot > 0 Then
If .Invent.Object(Slot).ObjIndex = 0 Then
Exit Sub
End If

Call DropObj(UserIndex, Slot, amount, .Pos.map, .Pos.X, .Pos.Y)
End If
End If
End With

End Sub