Richy420Rich Posted July 11, 2012 Author Share Posted July 11, 2012 Basically, this tutorial allows for manually setting players up with Membership access with automatic expiration, using Format time & day to calculate length, this base allows to create member only items and maps, (Membership Maps must use BootMap, BootX & BootY for expiration warping.). Simple UDT and checks can make this easily work with Member only quest as well, but it's not included in this base.Credit to Ambardia Productions & great thanks to Scott & Joost for other method support.**Edit: August 16th 2012 - Re-did the tutorial so it allows Moral to determine Map Membership instead of messing with UDT's. I found I had huge issues with the UDT - As I do not want to delete my maps.**We'll start with all the server code first.ModPlayer - JoinGame```Dim MyDate As String```Above 'End Sub'```MyDate = Format(Date, "m/d/yyyy")If Player(index).IsMember = 1 Then If DateDiff("d", Player(index).DateCount, MyDate) >= 31 Then PlayerMsg index, "Your membership has expired.", BrightRed MemberUnEquipItem index If Map(GetPlayerMap(index)).Moral = 2 Then PlayerWarp index, Map(GetPlayerMap(index)).BootMap, Map(GetPlayerMap(index)).BootX, Map(GetPlayerMap(index)).BootY End If Player(index).IsMember = 0 SavePlayer index Else PlayerMsg index, "You have " & (31 - DateDiff("d", Player(index).DateCount, MyDate)) & " days remaining of your membership!", Yellow End If End If```ModPlayer - UseItemAbove 'Select Case Item(itemnum).Type'``` If Item(itemnum).IsMember > 0 And Player(index).IsMember = 0 Then PlayerMsg index, "This is a members only item and can not be used without membership.", BrightRed Exit Sub End If```ModPlayer - Place whole;```Public Sub MemberUnEquipItem(ByVal index As Long)Dim recordbankslot As LongDim i As Long PlayerMsg index, "All 'Members only' items that are currently equipped will either go in your inventory or bank, if your inventory and bank is full, you'll lose the items. If you were in an 'Members only' area then you have been auto-warped to The Garden.", BrightRed For i = 1 To Equipment.Equipment_Count - 1 If GetPlayerEquipment(index, i) > 0 Then If Item(GetPlayerEquipment(index, i)).IsMember > 0 Then If FindOpenInvSlot(index, GetPlayerEquipment(index, i)) > 0 Then PlayerUnequipItem index, i ElseIf FindOpenBankSlot(index, GetPlayerEquipment(index, i)) > 0 Then recordbankslot = FindOpenBankSlot(index, GetPlayerEquipment(index, i)) SetPlayerBankItemNum index, recordbankslot, GetPlayerEquipment(index, i) SetPlayerBankItemValue index, recordbankslot, GetPlayerBankItemValue(index, i) + 1 SetPlayerEquipment index, 0, i Else SetPlayerEquipment index, 0, i End If End If End If Next i SendWornEquipment index SendMapEquipment index SavePlayer index SendPlayerData indexEnd Sub```ModTypes - Add this above OptionsRec```Public AEditor As PlayerRec```Now add these to the bottom of each rec name.PlayerRec``` IsMember As Byte DateCount As String```ItemRec``` IsMember As Byte```ModConstants - Add this under Map Morals.``` Public Const MAP_MORAL_MEMBER As Byte = 2```Now we have to edit the frmServer form, I uploaded an image of what this basically looks like - With the controls names texted in.![](http://www.freemmorpgmaker.com/files/imagehost/pics/13c90ffcdbad9eb4bfd808e6813bf8c5.PNG)Now for the frmServer codes, view it's code and paste all this up in it.```Private Sub SSTab1_Click(PreviousTab As Integer)Dim strload As StringDim i As LongDim TotalCount As LongIf frmServer.SSTab1.Tab = 3 Then frmServer.lstaccounts.Clear strload = Dir(App.Path & "\data\accounts\" & "*.bin") i = 1 Do While strload > vbNullString frmServer.lstaccounts.AddItem Mid(strload, 1, Len(strload) - 4) strload = Dir i = i + 1 Loop TotalCount = (i - 1) With frmServer .TextName.Text = vbNullString .TextPass.Text = vbNullString .TextCount.Text = Format(Date, "m/d/yyyy") .ChkMember.value = 0 .lblAcctCount.Caption = "" & TotalCount End WithEnd IfEnd SubPrivate Sub lstaccounts_Click()Dim Filename As StringDim f As LongIf Len(Trim$(lstaccounts.Text)) > 0 Then Filename = App.Path & "\data\accounts\" & Trim$(lstaccounts.Text) & ".bin" f = FreeFile Open Filename For Binary As #f Get #f, , AEditor Close #fWith frmServer .TextName.Text = Trim$(AEditor.Name) .TextPass.Text = Trim$(AEditor.Password) .ChkMember.value = AEditor.IsMember If AEditor.IsMember = 0 Then .TextCount.Text = Format(Date, "m/d/yyyy") Else .TextCount.Text = trim$(AEditor.DateCount) End If End WithEnd IfEnd SubPrivate Sub CmdSave_Click()Dim Filename As StringDim f As LongDim i As LongDim index As LongIf Len(Trim$(lstaccounts.Text)) > 0 ThenAEditor.Name = Trim$(TextName.Text)AEditor.Password = Trim$(TextPass.Text)if chkmember.value = 1 thenAEditor.IsMember = 1elseAEditor.DateCount = "11/11/2011"end ifAEditor.IsMember = chkmember.value index = FindPlayer(Trim$(AEditor.Name)) If index > 0 And index <= MAX_PLAYERS Then If IsPlaying(index) Then Player(index).Name = Trim$(TextName.Text) Player(index).Password = Trim$(TextPass.Text) Player(index).DateCount = trim$(TextCount.text) If ChkMember.value = 1 Then Player(index).IsMember = 1 Player(index).DateCount = Trim$(TextCount.Text) PlayerMsg index, "You have been granted membership by the server.", yellow" Else PlayerMsg index, "Your membership has been expired.", BrightRed Player(index).IsMember = 0 Player(index).DateCount = "11/11/2011" MemberUnEquipItem index If Map(GetPlayerMap(index)).Moral = 2 Then PlayerWarp index, Map(GetPlayerMap(index)).BootMap, Map(GetPlayerMap(index)).BootX, Map(GetPlayerMap(index)).BootY End If End If SavePlayer index SendPlayerData index End If Else Filename = App.Path & "\data\accounts\" & Trim$(lstaccounts.Text) & ".bin" f = FreeFile Open Filename For Binary As #f Put #f, , AEditor Close #f End If End If frmServer.lblInfo.Caption = vbNullString frmServer.lblInfo.Caption = "" & Trim$(lstaccounts.Text) & "'s account has been successfully saved!"End SubPrivate Sub ChkMember_Click()If ChkMember.value = 1 ThenfrmServer.lblInfo.Caption = vbNullStringfrmServer.lblInfo.Caption = "Membership goes by date, in the 'Day #' box is listed as today's date. The membership lasts for 31 days from today's date, you may give a longer date prior to membership expiration, EG: Today being 7/11/2012, it can be set to 12/11/2012, to give 5 months of membership. However the correct format is 'd/m/yyyy'. Otherwise this may not work."frmServer.LblInfo.Visible = Truefrmserver.TextCount.text = Format(Date, "m/d/yyyy")ElsefrmServer.lblInfo.Visible = FalsefrmServer.lblinfo.Caption = vbNullStringfrmserver.TextCount.text = "11/11/2011"End IfEnd Sub```ModServerLoopOn top. Add this:```Dim tmr60000 As Long```Before: If Not CPSUnlock Then Sleep 1Add this:``` 'Change the clock with this one. If Tick > tmr60000 Then frmServer.txttime.Text = Format(Time, "hh:mm AMPM") frmServer.txtday.Text = Format(Now, "dddd") Call TimedEvents tmr60000 = GetTickCount + 60000 End If```You have to add two textbox controls on the server, name them txttime and txtday.I added a new module called ModTimedEvents, but you can place this code below where you deem fit.```Public Sub TimedEvents()Dim i As LongDim MyDate As StringIf frmserver.txttime.text = "12:00 AM" ThenFor i = 1 To Player_HighindexIf Player(i).IsMember = 1 ThenMyDate = Format(Date, "m/d/yyyy") If DateDiff("d", Player(i).DateCount, MyDate) >= 31 Then PlayerMsg i, "Your membership has expired.", BrightRed MemberUnEquipItem i If Map(GetPlayerMap(i)).Moral = 2 Then PlayerWarp i, Map(GetPlayerMap(i)).BootMap, Map(GetPlayerMap(i)).BootX, Map(GetPlayerMap(i)).BootY End If Player(i).IsMember = 0 SavePlayer i Else PlayerMsg i, "You have " & (31 - DateDiff("d", Player(i).DateCount, MyDate)) & " days remaining of your membership!", Yellow End If End IfNext End IfEnd Sub```CLIENT - ModTypesAdd this above ' client-side stuff```Public AEditor As PlayerRec```Now add these to the bottom of each rec name.PlayerRec``` IsMember As Byte DateCount As String```ItemRec``` IsMember As Byte```ModConstants - Add this under Map Morals.``` Public Const MAP_MORAL_MEMBER As Byte = 2```GameLogic - UpdateDrawMapNameReplace with this:```Public Sub UpdateDrawMapName() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler DrawMapNameX = Camera.Left + ((MAX_MAPX + 1) * PIC_X / 2) - getWidth(TexthDC, Trim$(Map.Name)) DrawMapNameY = Camera.top + 1 Select Case Map.Moral Case MAP_MORAL_NONE DrawMapNameColor = QBColor(BrightRed) Case MAP_MORAL_SAFE DrawMapNameColor = QBColor(White) Case MAP_MORAL_MEMBER DrawMapNameColor = QBColor(Yellow) Case Else DrawMapNameColor = QBColor(White) End Select ' Error handler Exit Suberrorhandler: HandleError "UpdateDrawMapName", "modGameLogic", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd Sub```In your Map Properties Form, Add a Moral type to the combo box named Member.Now in your Item Editor, make a scroll bar control, name it scrlMember (In properties, make the Max = 1), Also make a label control next to it and name it lblMember - Its code.```Private Sub scrlMember_Change() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub If scrlMember.Value = 1 Then lblMember.Caption = "Member Item: True" Else lblMember.Caption = "Member Item: False" End If Item(EditorIndex).IsMember = scrlMember.Value ' Error handler Exit Suberrorhandler: HandleError "scrlMember_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd Sub```Now in ModGameEditorsGo to ItemInit - Put this in;```frmEditor_Item.scrlMember = .IsMember```If there are any bugs, please let me know so I can fix them up here. Thanks. Link to comment Share on other sites More sharing options...
JohnPony Posted July 11, 2012 Share Posted July 11, 2012 Considering you wouldn't be pulling information often, and its not much to pull in the first place. You could easily and efficiently add web integration with this. Link to comment Share on other sites More sharing options...
Guest Posted July 11, 2012 Share Posted July 11, 2012 correct me if IM wront, but 'Global routine, every night. If frmServer.txttime.Text = "12:00 AM" What happens if I make a player a mmember at 11:50PM Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 11, 2012 Author Share Posted July 11, 2012 It will count that player as being a member for 1 day already, the count starts at 0, so initially, the player has a 30 or 31 day membership. Link to comment Share on other sites More sharing options...
Guest Posted July 11, 2012 Share Posted July 11, 2012 hmm okay/ Now what happens when the server is offline? Link to comment Share on other sites More sharing options...
Joyce Posted July 11, 2012 Share Posted July 11, 2012 I would assume that if the server is offline, Membership would not update until it is run again. (But since you can't play on an offline server, yeah.) Link to comment Share on other sites More sharing options...
Joost Posted July 11, 2012 Share Posted July 11, 2012 I'm a bit worried about this sub performance-wise. Unless I'm missing something, this will loop through all the accounts and open them, if you have 1000 accounts that's 1000 files that're being opened, of which like 5% might actually be a member. Can't you just store an expiration date in the player's file and check if the date is in his file every time he logs in? If date expired, remove premium, if not do nothing, if player adds subscription increase date by 1 month.```Public Sub TimedEvents()Dim strload As StringDim i As LongDim Filename As StringDim f As LongDim index As Long 'Global routine, every night. If frmServer.txttime.Text = "12:00 AM" Then strload = Dir(App.Path & "\data\accounts\" & "*.bin") i = 1 Do While strload > vbNullString Filename = App.Path & "\data\accounts\" & strload f = FreeFile Open Filename For Binary As #f Get #f, , AEditor Close #f If AEditor.IsMember = 1 Then AEditor.DayCount = AEditor.DayCount + 1 Filename = App.Path & "\data\accounts\" & strload f = FreeFile Open Filename For Binary As #f Put #f, , AEditor Close #f End If index = FindPlayer(Trim$(AEditor.Name)) If index > 0 Then If IsPlaying(index) Then If AEditor.DayCount > 30 Then AEditor.DayCount = 31 AEditor.IsMember = 0 MemberUnEquipItem index If Map(GetPlayerMap(index)).IsMember > 0 Then PlayerWarp index, Map(GetPlayerMap(index)).BootMap, Map(GetPlayerMap(index)).BootX, Map(GetPlayerMap(index)).BootY End If End If End If End If strload = Dir i = i + 1 Loop End IfEnd Sub``` Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 11, 2012 Author Share Posted July 11, 2012 Thus is why I added the Purging System as well on my project.But on the other hand, this will only run once a day, which can be set at the least peak time to avoid complication. Seriously though, we're talking about Eclipse here, 70 player max.I do get what you're saying though, and I suppose one could store an expiration date in the players file and check on login, I however just hadn't found a way to do it like that.EDIT; Okay, I did make 5000 dummy accounts - It sparked curiosity as to how bad it would be. To be honest, I personally can deal with it if my project has a very inactive time during the day. The scan is about a minute or two, it does drop my FPS down from a steady 64 to (lowest - 29) but mainly bounces in between 29-64 until the scan is complete. The server becomes non-responsive during the scan. This is without the Purge System.With the purge system, one could add a check to see if the player is member or not, if they're a member - don't purge them.. If they aren't a member, purge them after 7 days. Why not since the account doesn't get deleted anyways and the player can log back into activity at any time.Eh, I'm not gonna fight about it anymore, it's here, daxterxx says he's gonna use it which he is the one that requested the system, I just figured since I would have given it to him, why not put it out for anyone who may want it. Link to comment Share on other sites More sharing options...
Joost Posted July 11, 2012 Share Posted July 11, 2012 70 players max, but thousands of accounts. I'd have no problem looping through all the online players, just opening 5000 dat files seems silly, when there are better alternatives. Link to comment Share on other sites More sharing options...
Guest Posted July 11, 2012 Share Posted July 11, 2012 You know, if people can upgrade from winsox to sox, you have hold alot more players. And an eclipse game can very well become a real game. Justt alotta effor is all. Its best to prepare for what you could potentially do. Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 11, 2012 Author Share Posted July 11, 2012 Well if an Eclipse game had 5000 accounts (ACTIVE) within 30 days, then yeah - You're right. But otherwise, inactive accounts can get purged whether by 30 days, 14 days or even 7 days. My purging system does not delete accounts.- So if both systems were put together, it will help the situation greatly. This is why I even added my Purging System in this tutorial, after the Membership System.But as I said before, games have peak times and games have real slow times, I'm going to pick a real slow time to do the scan process in my game and yes, I recommend whoever uses this tutorial to do the same.. Link to comment Share on other sites More sharing options...
Guest Posted July 11, 2012 Share Posted July 11, 2012 :) Good stuff anyway, no doubt im using it. Because i got 2 people who would actually want to buy a membership so i just made $10.00 thanks mate ;) Link to comment Share on other sites More sharing options...
Scott Posted July 11, 2012 Share Posted July 11, 2012 http://www.techrepublic.com/article/performing-date-comparisons-in-vb6/5799938Great article explaining just how easy it is to compare dates in vb6, much better than looping through any files even if it's once a day it's still unneeded. Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 12, 2012 Author Share Posted July 12, 2012 Older. Link to comment Share on other sites More sharing options...
wyvern640 Posted July 12, 2012 Share Posted July 12, 2012 Hey Richy, i did the first way and its working now, if i dont replace with the new tutorial i'l get bugs or something? Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 12, 2012 Author Share Posted July 12, 2012 The way it was before works, but it was not efficient enough - performance wise, with the old system, you're scanning and opening all of the files in the account folder every night.The new system does not scan and open the files every night and it just runs a date check on player login, to see if the membership expires or not.The new system is the better way to go in the long run, if you created a backup before you placed the system in, revert to it and place this one in. otherwise - you're gonna have to wait until I can note the code changes.Older… Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 12, 2012 Author Share Posted July 12, 2012 Bump update for those who have implemented the old tutorial, to know what to remove & change. Link to comment Share on other sites More sharing options...
Sakuray Posted July 12, 2012 Share Posted July 12, 2012 When the VIP is finish, and the item is equipped, happens error. Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 12, 2012 Author Share Posted July 12, 2012 Older. Link to comment Share on other sites More sharing options...
Joost Posted July 12, 2012 Share Posted July 12, 2012 I like your current method a lot more than the old one, the date method is how I would've done it. However, I'd still loop through all the online players at 12:00 each night to weed out people with expired subs, since technically as long as they dont log out the sub will continue. Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 12, 2012 Author Share Posted July 12, 2012 Um, good catch lol… Okay I'm gonna update the original post to allow that then.EDIT: Okay I'm calling this finalized.. Hopefully there's no bugs and such. Sorry for all these damned updates while people are trying to implement this. :( Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 12, 2012 Author Share Posted July 12, 2012 Older. Link to comment Share on other sites More sharing options...
davidsaid Posted July 27, 2012 Share Posted July 27, 2012 Hi, I have a problem putting the code. after putting it all and run the client, I get the following error when trying to access the item editor or the map editor Compile error: Invalid or unqualifiqued reference. and highlights the following:frmEditor_Map.ChkMember =. IsMember (highligths .IsMember). Some help D:? Link to comment Share on other sites More sharing options...
farrel24 Posted July 28, 2012 Share Posted July 28, 2012 Error Found in meInvalid or unqualifield reference–------------------------------------------------- frmEditor_Item.scrlMember = .IsMember Link to comment Share on other sites More sharing options...
Richy420Rich Posted July 30, 2012 Author Share Posted July 30, 2012 Older. Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now