| Mirage Source http://miragesource.net/forums/ |
|
| Bank http://miragesource.net/forums/viewtopic.php?f=210&t=4054 |
Page 1 of 1 |
| Author: | Robin [ Fri Jul 25, 2008 1:30 pm ] |
| Post subject: | Bank |
-Server- modTypes: Code: Type BankRec Item(1 To MAX_BANK_SLOTS) As PlayerInvRec End Type modGameLogic: Code: 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 Code: 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 Code: 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 Add to Sub PlayerUseKey: Code: ' bank check If Map(GetPlayerMap(index)).Tile(GetPlayerX(index), GetPlayerY(index)).Type = TILE_TYPE_BANK Then Call SendPlayerBank(index) Exit Sub End If Find:Call SavePlayer(index) in: Sub LeftGame. Add under: Code: Call SaveBank(index) modGameLogic: Code: 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 Code: Sub Clearbanks() Dim i As Long For i = 1 To MAX_PLAYERS Call ClearBank(i) Next i End Sub Code: 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 Add to InitServer: Code: Call SetStatus("Clearing banks...") Call Clearbanks Find: Call SavePlayer(i) in: PlayerSaveTimer add: Code: Call SaveBank(i) modServerTCP: Code: 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 Code: 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 modConstants: Code: Public Const MAX_BANK_SLOTS = 50 Code: Public Const TILE_TYPE_BANK = 12 modGlobals: Code: Public Bank(1 To MAX_PLAYERS) As BankRec Sub HandleData: Code: Dim BankNum As Long Find: LoadPlayer in: Login packet add: Code: Call LoadBank(index, Name) Find: SavePlayer in: AddChar packet add: Code: Call SaveBank(index) Add at bottom: Code: ' ::::::::::::::::::::: ' :: 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 Code: 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 modDatabase: Find: SavePlayer in: AddAccount add: Code: Call SaveBank(index) Find: SavePlayer in: SaveAllPlayersOnline add: Code: Call SaveBank(i) Add at bottom: Code: 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 |
|
| Author: | Robin [ Fri Jul 25, 2008 1:31 pm ] |
| Post subject: | Re: Bank |
Placeholder for client. |
|
| Author: | Jack [ Fri Jul 25, 2008 2:38 pm ] |
| Post subject: | Re: Bank |
How the fuck did you finish it before me i was like half way through |
|
| Author: | Robin [ Fri Jul 25, 2008 3:10 pm ] |
| Post subject: | Re: Bank |
I'm a better coder. |
|
| Author: | Rhyfelwr [ Tue Jul 29, 2008 1:14 am ] |
| Post subject: | Re: Bank |
You know, just as I was looking for a something like a bank here you come along with one! Now I just have to wait for the client! Thanks! |
|
| Author: | Kousaten [ Wed Aug 13, 2008 3:48 pm ] |
| Post subject: | Re: Bank |
Or study the server until you can come up with how to make the client work. |
|
| Author: | Robin [ Wed Aug 13, 2008 4:00 pm ] |
| Post subject: | Re: Bank |
Or just rip it from Essence. http://www.pwnz.co.uk |
|
| Author: | Kousaten [ Wed Aug 13, 2008 10:24 pm ] |
| Post subject: | Re: Bank |
True. Moot point, personally, to rip from something I intend to use. |
|
| Page 1 of 1 | All times are UTC |
| Powered by phpBB® Forum Software © phpBB Group https://www.phpbb.com/ |
|