[EO] Membership System

[Richy420Rich]

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 - UseItem
Above '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 Long
Dim 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 index
End 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.


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 String
Dim i As Long
Dim TotalCount As Long

If 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 With
End If
End Sub

Private Sub lstaccounts_Click()
Dim Filename As String
Dim f As Long

If 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 #f

With 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 With
End If
End Sub

Private Sub CmdSave_Click()
Dim Filename As String
Dim f As Long
Dim i As Long
Dim index As Long

If Len(Trim$(lstaccounts.Text)) > 0 Then

AEditor.Name = Trim$(TextName.Text)
AEditor.Password = Trim$(TextPass.Text)

if chkmember.value = 1 then
AEditor.IsMember = 1
else
AEditor.DateCount = "11/11/2011"
end if
AEditor.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 Sub

Private Sub ChkMember_Click()
If ChkMember.value = 1 Then
frmServer.lblInfo.Caption = vbNullString
frmServer.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 = True
frmserver.TextCount.text = Format(Date, "m/d/yyyy")
Else
frmServer.lblInfo.Visible = False
frmServer.lblinfo.Caption = vbNullString
frmserver.TextCount.text = "11/11/2011"
End If
End Sub

```
ModServerLoop
On top. Add this:

```
Dim tmr60000 As Long

```
Before: If Not CPSUnlock Then Sleep 1
Add 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 Long
Dim MyDate As String

If frmserver.txttime.text = "12:00 AM" Then
For i = 1 To Player_Highindex
If Player(i).IsMember = 1 Then
MyDate = 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 If
Next
End If
End Sub

```
CLIENT - ModTypes
Add 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 - UpdateDrawMapName

Replace 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 Sub
errorhandler:
    HandleError "UpdateDrawMapName", "modGameLogic", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End 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 Sub
errorhandler:
    HandleError "scrlMember_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

```
Now in ModGameEditors

Go 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.

[JohnPony]

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.

[Guest]

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

[Richy420Rich]

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.

[Guest]

hmm okay/ Now what happens when the server is offline?

[Joyce]

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.)

[Joost]

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 String
Dim i As Long
Dim Filename As String
Dim f As Long
Dim 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 If
End Sub
```

[Richy420Rich]

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.

[Joost]

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.

[Guest]

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.

[Richy420Rich]

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..

[Guest]

:) 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 ;)

[Scott]

http://www.techrepublic.com/article/performing-date-comparisons-in-vb6/5799938

Great 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.

[Richy420Rich]

Older.

[wyvern640]

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?

[Richy420Rich]

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…

[Richy420Rich]

Bump update for those who have implemented the old tutorial, to know what to remove & change.

[Sakuray]

When the VIP is finish, and the item is equipped, happens error.

[Richy420Rich]

Older.

[Joost]

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.

[Richy420Rich]

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. :(

[Richy420Rich]

Older.

[davidsaid]

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:?

[farrel24]

Error Found in me

Invalid or unqualifield reference
–-------------------------------------------------
    frmEditor_Item.scrlMember = .IsMember

[Richy420Rich]

Older.