Mirage Source

Type BankRec
  Item(1 To MAX_BANK_SLOTS) As PlayerInvRec
End Type

Function FindOpenBankSlot(ByVal index As Long, ByVal ItemNum As Long) As Long
  Dim i As Long
  FindOpenBankSlot = 0

  ' Check for subscript out of range
  If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
    Exit Function

  End If

  If Item(ItemNum).Type = ITEM_TYPE_CURRENCY Then

    ' If currency then check to see if they already have an instance of the item and add it to that
    For i = 1 To MAX_BANK_SLOTS

      If GetPlayerbankItemNum(index, i) = ItemNum Then
        FindOpenBankSlot = i
        Exit Function

      End If

    Next i

  End If

  For i = 1 To MAX_BANK_SLOTS

    ' Try to find an open free slot
    If GetPlayerbankItemNum(index, i) = 0 Then
      FindOpenBankSlot = i
      Exit Function

    End If

  Next i

End Function

Sub TakeBank(ByVal index As Long, _
             ByVal ItemNum As Long, _
             ByVal ItemVal As Long, _
             ByVal BankNum As Long)
  Dim i As Long

  ' Check for subscript out of range
  If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
    Exit Sub

  End If

  i = FindOpenInvSlot(index, ItemNum)

  ' Check to see if inventory is full
  If i <> 0 Then
    Call GiveItem(index, Bank(index).Item(BankNum).Num, 0)
    Call SetPlayerbankItemNum(index, BankNum, 0)
    Call SetPlayerbankItemValue(index, BankNum, 0)
    Call SetPlayerbankItemDur(index, BankNum, 0)
    Call SendInventoryUpdate(index, i)
    Call SendBankUpdate(index, BankNum)
  Else
    Call PlayerMsg(index, "Your inventory is full.", BrightRed)
  End If

End Sub

Sub GiveBank(ByVal index As Long, ByVal ItemNum As Long, ByVal ItemVal As Long)
  Dim i As Long

  ' Check for subscript out of range
  If IsPlaying(index) = False Or ItemNum <= 0 Or ItemNum > MAX_ITEMS Then
    Exit Sub

  End If

  i = FindOpenBankSlot(index, ItemNum)

  ' Check to see if bank is full
  If i <> 0 Then
    Call SetPlayerbankItemNum(index, i, ItemNum)
    Call SetPlayerbankItemValue(index, i, GetPlayerbankItemValue(index, i) + ItemVal)

    If (Item(ItemNum).Type = ITEM_TYPE_ARMOR) Or (Item(ItemNum).Type = ITEM_TYPE_WEAPON) Or (Item(ItemNum).Type = ITEM_TYPE_HELMET) Or (Item(ItemNum).Type = ITEM_TYPE_SHIELD) Then
      Call SetPlayerbankItemDur(index, i, Item(ItemNum).Data1)
    End If

    'Call SendInventoryUpdate(index, i)
    Call SendBankUpdate(index, i)
  Else
    Call PlayerMsg(index, "Your bank is full.", BrightRed)
  End If

End Sub

' bank check
  If Map(GetPlayerMap(index)).Tile(GetPlayerX(index), GetPlayerY(index)).Type = TILE_TYPE_BANK Then
    Call SendPlayerBank(index)
    Exit Sub

  End If

Call SaveBank(index)

Sub ClearBank(ByVal index As Long)
  Dim i As Byte

  For i = 1 To MAX_BANK_SLOTS
    Bank(index).Item(i).Num = 0
    Bank(index).Item(i).Dur = 0
    Bank(index).Item(i).Value = 0
  Next

End Sub

Sub Clearbanks()
  Dim i As Long

  For i = 1 To MAX_PLAYERS
    Call ClearBank(i)
  Next i

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

Sub SetPlayerbankItemValue(ByVal index As Long, _
                           ByVal bankSlot As Long, _
                           ByVal ItemValue As Long)
  Bank(index).Item(bankSlot).Value = ItemValue
End Sub

Function GetPlayerbankItemDur(ByVal index As Long, ByVal bankSlot As Long) As Long
  GetPlayerbankItemDur = Bank(index).Item(bankSlot).Dur
End Function

Sub SetPlayerbankItemDur(ByVal index As Long, _
                         ByVal bankSlot As Long, _
                         ByVal ItemDur As Long)
  Bank(index).Item(bankSlot).Dur = ItemDur
End Sub

Call SetStatus("Clearing banks...")
  Call Clearbanks

Call SaveBank(i)

Sub SendBankUpdate(ByVal index As Long, ByVal InvSlot As Long)
  Dim Packet As String
  Packet = "PLAYERBANKUPDATE" & SEP_CHAR & InvSlot & SEP_CHAR & GetPlayerbankItemNum(index, InvSlot) & SEP_CHAR & GetPlayerbankItemValue(index, InvSlot) & SEP_CHAR & GetPlayerbankItemDur(index, InvSlot) & SEP_CHAR & END_CHAR
  Call SendDataTo(index, Packet)
End Sub

Sub SendPlayerBank(ByVal index As Long)
  Dim Packet As String
  Dim i      As Long
  Packet = "bank" & SEP_CHAR

  For i = 1 To MAX_BANK_SLOTS
    Packet = Packet & Bank(index).Item(i).Num & SEP_CHAR
    Packet = Packet & Bank(index).Item(i).Value & SEP_CHAR
    Packet = Packet & Bank(index).Item(i).Dur & SEP_CHAR
  Next

  Packet = Packet & END_CHAR
  Call SendDataTo(index, Packet)
End Sub

Public Const MAX_BANK_SLOTS = 50

Public Const TILE_TYPE_BANK = 12

Public Bank(1 To MAX_PLAYERS)      As BankRec

Dim BankNum   As Long

Call LoadBank(index, Name)

Call SaveBank(index)

' :::::::::::::::::::::
  ' :: bank item packet ::
  ' :::::::::::::::::::::
  If LCase(Parse(0)) = "bankitem" Then
    InvNum = Val(Parse(1))
    CharNum = Player(index).CharNum

    ' Prevent hacking
    If InvNum < 1 Or InvNum > MAX_INV Then
      Call HackingAttempt(index, "Invalid InvNum")
      Exit Sub

    End If

    ' Prevent hacking
    If CharNum < 1 Or CharNum > MAX_CHARS Then
      Call HackingAttempt(index, "Invalid CharNum")
      Exit Sub

    End If

    If (GetPlayerInvItemNum(index, InvNum) > 0) And (GetPlayerInvItemNum(index, InvNum) <= MAX_ITEMS) Then
      'If FindOpenBankSlot(index, Player(index).Char(CharNum).Inv(InvNum).Num) = 1 Then
      Call GiveBank(index, GetPlayerInvItemNum(index, InvNum), 1)
      Call TakeItem(index, GetPlayerInvItemNum(index, InvNum), 0)
      Exit Sub

      'End If
    End If
  End If

  If LCase(Parse(0)) = "usebankitem" Then
    BankNum = Val(Parse(1))
    CharNum = Player(index).CharNum

    ' Prevent hacking
    If BankNum < 1 Or BankNum > MAX_BANK_SLOTS Then
      Call HackingAttempt(index, "Invalid BankNum")
      Exit Sub

    End If

    ' Prevent hacking
    If CharNum < 1 Or CharNum > MAX_CHARS Then
      Call HackingAttempt(index, "Invalid CharNum")
      Exit Sub

    End If

    If (GetPlayerbankItemNum(index, BankNum) > 0) And (GetPlayerbankItemNum(index, BankNum) <= MAX_ITEMS) Then
      'If FindOpenBankSlot(index, Player(index).Char(CharNum).Inv(InvNum).Num) = 1 Then
      Call TakeBank(index, Bank(index).Item(BankNum).Num, 1, BankNum)
      Exit Sub

      'End If
    End If
  End If

If LCase(Parse(0)) = "exitbank" Then
    SaveBank (index)

    Select Case GetPlayerDir(index)

      Case DIR_UP
        Call PlayerMove(index, DIR_DOWN, 1)
        SendDataTo index, "playermove" & SEP_CHAR & index & SEP_CHAR & GetPlayerX(index) & SEP_CHAR & GetPlayerY(index) & SEP_CHAR & GetPlayerDir(index) & SEP_CHAR & "1" & SEP_CHAR & END_CHAR
        SendDataTo index, "exitbank" & SEP_CHAR & END_CHAR
        Exit Sub

      Case DIR_DOWN
        Call PlayerMove(index, DIR_UP, 1)
        SendDataTo index, "playermove" & SEP_CHAR & index & SEP_CHAR & GetPlayerX(index) & SEP_CHAR & GetPlayerY(index) & SEP_CHAR & GetPlayerDir(index) & SEP_CHAR & "1" & SEP_CHAR & END_CHAR
        SendDataTo index, "exitbank" & SEP_CHAR & END_CHAR
        Exit Sub

      Case DIR_LEFT
        Call PlayerMove(index, DIR_RIGHT, 1)
        SendDataTo index, "playermove" & SEP_CHAR & index & SEP_CHAR & GetPlayerX(index) & SEP_CHAR & GetPlayerY(index) & SEP_CHAR & GetPlayerDir(index) & SEP_CHAR & "1" & SEP_CHAR & END_CHAR
        SendDataTo index, "exitbank" & SEP_CHAR & END_CHAR
        Exit Sub

      Case DIR_RIGHT
        Call PlayerMove(index, DIR_LEFT, 1)
        SendDataTo index, "playermove" & SEP_CHAR & index & SEP_CHAR & GetPlayerX(index) & SEP_CHAR & GetPlayerY(index) & SEP_CHAR & GetPlayerDir(index) & SEP_CHAR & "1" & SEP_CHAR & END_CHAR
        SendDataTo index, "exitbank" & SEP_CHAR & END_CHAR
        Exit Sub

    End Select
  End If

Call SaveBank(index)

Call SaveBank(i)

Sub SaveBank(ByVal index As Long)
  Dim FileName As String
  Dim nFileNum As Integer
  FileName = App.Path & "\data\banks\" & Trim(Player(index).Login) & ".dat"
  nFileNum = FreeFile
  Open FileName For Binary As #nFileNum
  Put #nFileNum, , Bank(index)
  Close #nFileNum
End Sub

Sub LoadBank(ByVal index As Long, ByVal Name As String)
  Dim FileName As String
  Dim nFileNum As Integer
  Call ClearBank(index)
  FileName = App.Path & "\data\banks\" & Trim(Name) & ".dat"
  nFileNum = FreeFile
  Open FileName For Binary As #nFileNum
  Get #nFileNum, , Bank(index)
  Close #nFileNum
ErrorHandlerExit:
  Exit Sub

ErrorHandler:
  ReportError "modDatabase.bas", "Loadbank", Err.Number, Err.Description
End Sub