[EO] Daily Reward System

[Matt]

Many games use a system in which the players are rewarded for playing every day. I managed to apply this to Eclipse.

Lets start off client side.

Go to the bottom of PlayerRec and put there

```

DailyValue As Long

```

Look for```

Function GetPlayerExp(ByVal Index As Long) As Long

```

and underneath that function, put there

```

Sub SetPlayerDailyValue(ByVal Index As Long, ByVal DailyValue As Long)

' If debug mode, handle error then exit out

If Options.Debug = 1 Then On Error GoTo errorhandler

If Index > MAX_PLAYERS Then Exit Sub

Player(Index).DailyValue = DailyValue

' Error handler

Exit Sub

errorhandler:

HandleError "SetPlayerDailyValue", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext

Err.Clear

Exit Sub

End Sub

```

Now go to to HandlePlayerData and put there

```

Call SetPlayerDailyValue(i, Buffer.ReadLong)

```

underneath

```

Call SetPlayerPK(i, Buffer.ReadLong)

```

Save and compile.

Onward to the server!

Click on the Control tab and check to see if you have enough room to put there about 4 medium sized labels and a command button.

If not, then use this to make a new tab.

Click on the SSTab1 and find in it's properties "Tabs" and "Tabs per Row"

Change Tabs per Row to 4, and **then** change Tabs to 4.

Now right click over SSTab1 and hit properties. You'll see Current Tab and TabCaption. Go to 3 on the Current Tab, and then you can change the name of the tab.

Now that you have some room to work, lets put in those 4 labels and command button. I made mine look like this.


Please note that the text Current Value: and Last Daily Set: are separate from the 0 and Unknown. **Remember; there are four labels altogether.**

Name the 0 label lblDailyValue

Name the Unkown label lblLastDate

Double click on the button and put there

```

Call SetDailyValues

```

Look for Private Sub Form_Load()

Put there```

Call DailyValues

```

Now go to the bottom of the Server code and put there this

```

Private Function DailyValues()

Dim CurrentDate1 As Date

Dim CurrentDate2 As String

Dim i As String

If Dir(App.Path & "\data\DailyValueDate.txt") <> "" Then

If Dir(App.Path & "\data\DailyValue.txt") <> "" Then

Open App.Path & "\data\DailyValueDate.txt" For Input As #1

Input #1, i

Close #1

lblLastDate.Caption = i

Open App.Path & "\data\DailyValue.txt" For Input As #1

Input #1, i

Close #1

lblDailyValue.Caption = i

CurrentDate1 = DateValue(Now)

CurrentDate2 = CurrentDate1

If CurrentDate2 <> lblLastDate.Caption Then

Call SetDailyValues

End If

End If

Else

Open App.Path & "\data\DailyValueDate.txt" For Output As #1

Print #1, "0"

Close #1

Open App.Path & "\data\DailyValue.txt" For Output As #1

Print #1, "0"

Close #1

Call SetDailyValues

End If

End Function

Private Function SetDailyValues()

Dim CurrentDate1 As Date

Dim CurrentDate2 As String

Dim NewValue As String

Dim i As Long

CurrentDate1 = DateValue(Now)

CurrentDate2 = CurrentDate1

lblLastDate.Caption = CurrentDate2

Open App.Path & "\data\DailyValueDate.txt" For Output As #1

Print #1, lblLastDate.Caption

Close #1

lblDailyValue.Caption = lblDailyValue.Caption + 1

Open App.Path & "\data\DailyValue.txt" For Output As #1

Print #1, lblDailyValue.Caption

Close #1

For i = 1 To MAX_PLAYERS

If Player(i).DailyValue <> frmServer.lblDailyValue.Caption Then

If FindOpenInvSlot(i, 1) = 0 Then

PlayerMsg i, "You can get your daily reward, but you need to login with room in your inventory first.", BrightRed

End If

If FindOpenInvSlot(i, 1) <> 0 Then

GiveInvItem i, 1, 0

PlayerMsg i, "You have acquired a daily reward!", White

Player(i).DailyValue = frmServer.lblDailyValue.Caption

End If

End If

Next

End Function

```

Now look for```

Private Sub HandleLogin(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

```

Right after this chunk of code```

' Show the player up on the socket status

Call AddLog(GetPlayerLogin(index) & " has logged in from " & GetPlayerIP(index) & ".", PLAYER_LOG)

Call TextAdd(GetPlayerLogin(index) & " has logged in from " & GetPlayerIP(index) & ".")

```

Put there

```

If Player(index).DailyValue <> frmServer.lblDailyValue.Caption Then

If FindOpenInvSlot(index, 1) = 0 Then

PlayerMsg index, "You can get your daily reward, but you need to login with room in your inventory first.", BrightRed

End If

If FindOpenInvSlot(index, 1) <> 0 Then

GiveInvItem index, 1, 0

PlayerMsg index, "You have acquired a daily reward!", White

Player(index).DailyValue = frmServer.lblDailyValue.Caption

End If

End If

```

Lastly, to make the DailyValue on the server side. Go to modTypes and go to PlayerRec. At the bottom, put there```

DailyValue As Long

```

Find Function GetPlayerAccess(ByVal index As Long) As Long and right above it, put there this

```

Function GetPlayerDailyValue(ByVal index As Long) As Long

If index > MAX_PLAYERS Then Exit Function

GetPlayerDailyValue = Player(index).DailyValue

End Function

```

Now go to Function PlayerData(ByVal index As Long) As Byte() and put there this

```

Buffer.WriteLong GetPlayerDailyValue(index)

```

And that should be it! Save it, compile it, and enjoy.

[iSnow]

Looks good Matthew, rewards people for playing.

[Matt]

Thank you! That was the idea 

[Guest]

Why are you using functions when you're returning no values (DailyValues and SetDailyValues)?

[Alerd]

shell works 

[Matt]

> Why are you using functions when you're returning no values (DailyValues and SetDailyValues)?

Ah yes you have a good point. I'm not the best programmer. The way I learnt was solely "hands on". I used functions ever since I started using VB6 not entirely understanding what they were supposed to do. Its just out of bad habit that I use them, and me not thinking properly.

> do not work terribly many mistakes crashes; X
>
> as there is with the player socker or exp

I'll look into it. I haven't gotten that error. When does it happen?

[Alerd]

shell works 

Only occasionally is any error with socket

[abhi2011]

@Sekaru

So what should be used to return nothing? Subs?

[Matt]

> @Sekaru
>
> So what should be used to return nothing? Subs?

Yes. Subs return nothing.

[abhi2011]

Just like voids.

[Scorge]

I'm lost with this, can you post pictures of a walkthrough?

[Matt]

Which bit is troubling you?

[Scorge]

Pretty much the beginning to end.

[Matt]

I've just gone over the entire thing, and it's rather simple. I don't see a purpose of screenshotting the entire thing. I can either help you out in person, or upload a vanilla engine with this system in it for you to compare it to.

[Daneta]

> I've just gone over the entire thing, and it's rather simple. I don't see a purpose of screenshotting the entire thing. I can either help you out in person, or upload a vanilla engine with this system in it for you to compare it to.

do that plss

[imamPeewee]

Available in EA..?

[abhi2011]

Yes it will.

[Domino_]

You should add that everyone gets random item between selected like rdm(3,5,20) and one player gets item 20 other item 5\. :)

Also there should need to add automatic reset, so it would be easyer. :)

[Matt]

> You should add that everyone gets random item between selected like rdm(3,5,20) and one player gets item 20 other item 5\. :)
>
> Also there should need to add automatic reset, so it would be easyer. :)

This is meant to be a base. Feel free to tweak it ^_^ What do you mean by "Automatic reset"?

[Domino_]

That you dont need to press the reset button by yourself, but he automatically does that every day @ 22:00 or every seven days @ some time.

[Domino_]

~~You need to change~~

```

For i = 1 To MAX_PLAYERS

```
~~to~~

```

For i = 0 To MAX_PLAYERS
    If i = 0 Then Exit Function

```
~~Or you will getsome socket errors.~~

Damn im getting error what i did wrong? :D

[attachment=1084:errrrrrr.png]