[EO 2.0/3.0] Serial Number, Redeem Item or etc [Fixed]

[PVJsquad]

**INTRO** :

ohh no! I get a weird code, is it useful? That's why I made ​​the serial code to get a secret item.

>! 
**What i Editing or adding?**

* **Client** : modCode, modConstants, modEnumurations, modHandledata, modInput, frmMain, frmSerial
* **Server** : modCode, modConstants, modDatabase, modEnumurations, modGeneral, modHandledata, modPlayer

**Difficulty** **:** Medium
**Date Fixed** : 20/02/2013
**Extra Files** : [http://www.mediafire…cq0up4m43s3i4t9](http://www.mediafire.com/?cq0up4m43s3i4t9)
**Recomended** : Start Over Fresh
**Engine** : EO 2.0, EO 3.0, EA
**Notes** : serial code will be removed when it is used
**Thanks to** : [Kemerd](http://www.eclipseorigins.com/community/index.php?/user/53239-kemerd/) , [DarkDino](http://www.eclipseorigins.com/community/index.php?/user/48122-darkdino/)

**>! Try EA + Serial System *not recommeded
>! [http://www.eclipseorigins.com/community/index.php?/topic/125864-eo-2030-serial-number-redeem-item-or-etc-fixed/?p=905554](http://www.eclipseorigins.com/community/index.php?/topic/125864-eo-2030-serial-number-redeem-item-or-etc-fixed/?p=905554)

The system has been fixed at 07/09/2014 so don't use other fixed in this thread

**SERVER SIDE**

add the **modCode.bas** to your project

Open **modCode** in **Public Type SerialRec** replace

```

Name As String * NAME_LENGTH
```
to

```

Name As String * SERIAL_LENGTH
```
Open **modConstant** add in the bottom

```

Public Const SERIAL_LENGTH As Byte = 10 ' Change this value to max length you like in your codes
```
Open **modDatabase** add in the bottom

```
' serial
Sub SaveSerialNumbers(ByVal i As Long)
For i = 1 To MAX_SERIAL_NUMBER
Call SaveSerialNumber(i)
Next
End Sub
Sub SaveSerialNumber(ByVal SerialNum As Long)
Dim filename As String
Dim F As Long
filename = App.path & "\data\serial\" & SerialNum & ".dat"
F = FreeFile
Open filename For Binary As #F
Put #F, , Serial(SerialNum)
Close #F
End Sub
Sub LoadSerialNumbers()
Dim filename As String
Dim i As Long
Dim F As Long
Dim sLen As Long

Call CheckSerialNumber
For i = 1 To MAX_SERIAL_NUMBER
filename = App.path & "\data\serial\" & i & ".dat"
F = FreeFile
Open filename For Binary As #F
Get #F, , Serial(i)
Close #F
Next
End Sub
Sub CheckSerialNumber()
Dim i As Long
For i = 1 To MAX_SERIAL_NUMBER
If Not FileExist("\Data\serial\" & i & ".dat") Then
Call SaveSerialNumbers(i)
End If
Next
End Sub

Sub ClearSerialNumbers()
Dim i As Long
For i = 1 To MAX_SERIAL_NUMBER
Call ClearSerialNumber(i)
Next
End Sub
Sub ClearSerialNumber(ByVal index As Long)
Call ZeroMemory(ByVal VarPtr(Serial(index)), LenB(Serial(index)))
Serial(index).Name = vbNullString
'ReDim Serial(index)
End Sub
```
Open **modEnumurations** add above **SMSG_COUNT**

```
'serial
SSerialEditor
SUpdateSerial
```
add above **CMSG_COUNT**

```
'Serial
CSaveSerial
CRequestSerial
CRequestEditSerial
CSerialGift
```
Open **modGeneral** in **InitServer()**

below

```
ChkDir App.path & "\Data\", "spells"
```
add

```
ChkDir App.path & "\Data\", "serial"
```
find

```
Call SetStatus("Clearing spells...")
Call ClearSpells
```
add below it

```
Call SetStatus("Clearing database...")
Call ClearSerialNumbers
```
find

```
Call SetStatus("Loading spells...")
Call LoadSpells
```
add below it

```
Call SetStatus("Loading database...")
Call LoadSerialNumbers
```
Open **modHandledata** in **InitMessage()**

add

```
'Serial
HandleDataSub(CSaveSerial) = GetAddress(AddressOf HandleSaveSerial)
HandleDataSub(CRequestSerial) = GetAddress(AddressOf HandleRequestSerial)
HandleDataSub(CRequestEditSerial) = GetAddress(AddressOf HandleEditSerial)
HandleDataSub(CSerialGift) = GetAddress(AddressOf HandleSerialGift)
```
and add the code in the bottom of module

```
' Serial
Sub HandleEditSerial(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim buffer As clsBuffer
' Prevent hacking
If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
Exit Sub
End If
Set buffer = New clsBuffer
buffer.WriteLong SSerialEditor
SendDataTo index, buffer.ToArray()
Set buffer = Nothing
End Sub
Sub HandleRequestSerial(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
SendSerial index
End Sub
Private Sub HandleSaveSerial(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim SerialNum As Long
Dim buffer As clsBuffer
Dim SerialSize As Long
Dim SerialData() As Byte
' Prevent hacking
If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
Exit Sub
End If
Set buffer = New clsBuffer
buffer.WriteBytes Data()
SerialNum = buffer.ReadLong
' Prevent hacking
If SerialNum < 0 Or SerialNum > MAX_SERIAL_NUMBER Then
Exit Sub
End If
SerialSize = LenB(Serial(SerialNum))
ReDim SerialData(SerialSize - 1)
SerialData = buffer.ReadBytes(SerialSize)
CopyMemory ByVal VarPtr(Serial(SerialNum)), ByVal VarPtr(SerialData(0)), SerialSize
' Save it
Call SendUpdateSerialToAll(SerialNum)
Call SaveSerialNumber(SerialNum)
'Call AddLog(GetPlayerName(index) & " saved Serial Code #" & SerialNum & ".", ADMIN_LOG)
End Sub
Public Sub HandleSerialGift(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim buffer As clsBuffer
Dim Item As Long, Value As Long

Set buffer = New clsBuffer
buffer.WriteBytes Data()
Item = buffer.ReadLong
Value = buffer.ReadLong

GivePlayerItems index, Item, Value
PlayerMsg index, "Kamu Mendapatkan Item Dari serial code cek Inventori mu!", Yellow
End Sub
```
**Notes : If You Use EO 2.0 use that**

repalce **HandleSerialGift** with this

```
Public Sub HandleSerialGift(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim buffer As clsBuffer
Dim Item As Long, Value As Long

Set buffer = New clsBuffer
buffer.WriteBytes Data()
Item = buffer.ReadLong
Value = buffer.ReadLong

GiveInvItem index, Item, Value

PlayerMsg index, "Kamu Mendapatkan Item Dari serial code cek Inventori mu!", Yellow
End Sub
```
Open **modPlayer**

below

```
Call SendSpells(index)
```
add

```
Call SendSerial(index)
```
**CLIENT SIDE**

add **frmEditor_Serial.frm** and **modCode.bas** to your project

Open **modConstants** find

```
Public Const EDITOR_ANIMATION As Byte = 6
```
add below it

```
Public Const EDITOR_SERIAL_NUMBER As Byte = 7 'or next number
```
add this code in bottom **modConstant**

```

Public Const SERIAL_LENGTH As Byte = 10 ' Change this value to max length you like in your codes
```
in **modEnumurations** add

```
'serial
SSerialEditor
SUpdateSerial
```
add too

```
'Serial
CSaveSerial
CRequestSerial
CRequestEditSerial
CSerialGift
```
Open **modHandledata** in **InitMessage()**

add

```
'Serial
HandleDataSub(SSerialEditor) = GetAddress(AddressOf HandleSerialEditor)
HandleDataSub(SUpdateSerial) = GetAddress(AddressOf HandleUpdateSerial)
```
add in the bottom module

```
' serial
Private Sub HandleSerialEditor()
Dim i As Long
With frmEditor_Serial
Editor = EDITOR_SERIAL_NUMBER
.lstIndex.Clear
' Add the names
For i = 1 To MAX_SERIAL_NUMBER
.lstIndex.AddItem i & ": " & Trim$(Serial(i).Name)
Next
.Show
.lstIndex.ListIndex = 0
SerialEditorInit
End With
End Sub
Private Sub HandleUpdateSerial(ByVal Index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim serialNum As Long
Dim buffer As clsBuffer
Dim serialSize As Long
Dim serialData() As Byte

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

Set buffer = New clsBuffer
buffer.WriteBytes data()

serialNum = buffer.ReadLong

serialSize = LenB(Serial(serialNum))
ReDim serialData(serialSize - 1)
serialData = buffer.ReadBytes(serialSize)

ClearSerial serialNum

CopyMemory ByVal VarPtr(Serial(serialNum)), ByVal VarPtr(serialData(0)), serialSize

Set buffer = Nothing

' Error handler
Exit Sub
errorhandler:
HandleError "HandleUpdateserials", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```
Open **modInput** find

```
Case "/help"
```
add above it

```
Case "/editserial"
If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo Continue

SendRequestSerial
SendRequestEditSerial

Case "/redeem"

frmmain.picClaim.visible = not picClaim.visible

```
**CLIENT WORK**

add picturebox, textbox and command button name it **picClaim,** **txtCode** and **cmdClaim**

make like this


Set **picClaim** visible to **False**

Double Click the **cmdClaim** and Add this

```

Dim a As Long
If txtCode.Text = vbNullString Then
txtCode.Text = "Not Valid Code!"
Else
For a = 1 To MAX_SERIAL_NUMBER
If txtCode.Text = Serial(a).Name Then
Call SendSerialGift(MyIndex, Serial(a).Item, Serial(a).ItemValue)
Call ClearSerial(a)
Call SendSaveSerial(a)

txtCode.Text = "Item Send to your Inv..."
picClaim.visible = False
Exit Sub
End If
Next
txtCode.Text = "Not Valid Code!"
picClaim.Visible = False
End If
```
Go to **frmSerial** and click **txtName**


Change the MAX LENGTH to Public Const SERIAL_LENGTH As Byte = **10 **<- to your VALUE in SERIAL_LENGTH


**WELL DONE****

[fernz123]

Thanks, I could use this for events in-game.

[Zopto]

some litl bugs..but fix able!

[PVJsquad]

You're welcome Guy's please if you have Bug's report me

[Killa_]

Nah ive made a topic with a question on how to make the same system..Thanks for the answer :D

[Zopto]

@Killa_:

> Nah ive made a topic with a question on how to make the same system..Thanks for the answer :D

what are you talking about? o.o what answer

[DshWinchester]

this system does what? .-.

[PVJsquad]

to send an item by using the text to send to the inventory,with Sistem Text Editor

[Domino_]

>! Private Sub cmdClaim_Click()
Dim a As Long
Dim n As String
>! For a = 1 To MAX_SERIAL_NUMBER 'or what ever you called it
>!     If txtClaim.text = Serial(a).Name Then
        SendSpawnItem Serial(a).Item, Serial(a).ItemValue
        CheckMapGetItem
        Call ClearSerial(a)

        If Serial_Changed(a) Then '( what if?, dont need if I think… )
            Call SendSavedoor(a)
        End If

        lblClaimStatus.Caption = "Status: [Success] Item Successfully Delivered."

        Exit Sub
    End If
>! Next
>! lblClaimStatus.Caption = "Status: [Failed] code is invalid or already in use."
End Sub

o.O

Dont need to be SendSaveSerial ?

edit: Your missing smtn… ( Serial_Changed )

[Justn]

@Zopto:

> works grate tnx..^^

I don't think u even added it cause I tried to test and got same error as domino

[Domino_]

@Justn:

> I don't think u even added it cause I tried to test and got same error as domino

Maybe he added and just run server without full compile so bugging his work..

p.s. ill try to fix this tomorrow if this wount be fixed, g2g to sleep xD

[Zopto]

.

[Wortel Angels]

Serial_Changed
–---------------
Sub or function not defined...

[Domino_]

@Zopto:

> works grate tnx..^^

Why didn you told us about bug that there is mistakes in code then? Because he answered you.

@GoldSide:

> You're welcome Guy's please if you have Bug's report me

Need to explain what means "bug" ? :D

[PVJsquad]

@Mortal:

> Serial_Changed
> –---------------
> Sub or function not defined...

**Client Side**
Open **modGlobals**
find :
```
Public Shop_Changed(1 To MAX_SHOPS) As Boolean
```add this below it
```
Public Serial_Changed(1 To MAX_SERIAL_NUMBER) As Boolean
```
@Domino_:

> Need to explain what means "bug" ? :D

Other Word For ERROR :D

**FIX System**

* * *

**Client Side**
Open **frmMain** double click **cmdClaim**
find :
```
If Serial_Changed(a) Then
            Call SendSavedoor(a)
        End If
```replace with
```
Call SendSaveSerial(a)
```
Open **modGlobals**
find :
```
Public Shop_Changed(1 To MAX_SHOPS) As Boolean
```add this below it
```
Public Serial_Changed(1 To MAX_SERIAL_NUMBER) As Boolean
```
Thank To **Domino_**

* * *

**Server Side**
open **modHandleData** in **Sub HandleSpawnItem**
find :
```
If GetPlayerAccess(index) < ADMIN_CREATOR Then Exit Sub
```Give The comment Line Like This:
```
'If GetPlayerAccess(index) < ADMIN_CREATOR Then Exit Sub
```or delete it if you not need the code

***Notes :** the server FIX for the give item to Inventory Not Admin Member

[Domino_]

Thanks for fix, but Where is command to open serial editor in game? xD
like /editserial or smtn.?
Ohh sry found, just need to add command. ^^

[PVJsquad]

@Domino_:

> Thanks for fix, but Where is command to open serial editor in game? xD
> like /editserial or smtn.?
> Ohh sry found, just need to add command. ^^

You are absolutely right, you are very helpful.

**Fixed Again**
open **frmMain** Look In admin panel
add new **command button**
-name it **cmdAClaim**
-caption it **Set Code**

like this
double click the command
and add this

```
Private Sub cmdAClaim_Click()
' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then

        Exit Sub
    End If

    SendRequestEditSerial

    ' Error handler
    Exit Sub
errorhandler:
    HandleError "cmdAItem_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub
```

[PVJsquad]

Thanks For you found in my program Bug's

[Wortel Angels]

Now it works.. but
i must type in
1                    <–- whith many spaces and then it dissapear from the list when i open the editor and close it and open again its there and the code work again one time... how can i fix that
ill use it only for GM's because i got many items and then its better to get the code in than search xD

So whats to fix?

Save serial in the list forever O.o
Delete the self generated spaces >.<

[kahnival]

This is a great idea that I'll probably be implementing into my project!

But a quick question/suggestion you may not have thought of…But is there a way to limit it to one use of the code per person so that people don't just spam and farm the items if say the code gave a rare expensive item. And a way to make unique codes for each person?

For example Person A gets code for Big Bag of Gold and uses said code and then gives the code to Person B who uses it to get the item as well...That wouldn't be cool :(

[Domino_]

@kahnival:

> This is a great idea that I'll probably be implementing into my project!
>
> But a quick question/suggestion you may not have thought of…But is there a way to limit it to one use of the code per person so that people don't just spam and farm the items if say the code gave a rare expensive item. And a way to make unique codes for each person?
>
> For example Person A gets code for Big Bag of Gold and uses said code and then gives the code to Person B who uses it to get the item as well...That wouldn't be cool :(

I have similar problem when lots of spaces shows up afther opening editor again and all time he says that code is wrong. xD ill reinstall code , maybe i have made a mistake. ;D

[PVJsquad]

@Mortal:

> Now it works.. but
> i must type in
> 1                    <–- whith many spaces and then it dissapear from the list when i open the editor and close it and open again its there and the code work again one time... how can i fix that
> ill use it only for GM's because i got many items and then its better to get the code in than search xD
>
> So whats to fix?
>
> Save serial in the list forever O.o
> Delete the self generated spaces >.<

For This Problem I recommend

in **SERVER** and **CLIENT**
find the code in **modTypes**
```
Public Type SerialRec
    Name As String * NAME_LENGTH
    NamePlayer As String * NAME_LENGTH

    Item As Long
    ItemValue As Long
End Type
```
delete *** NAME_LENGTH**

like this
```
Public Type SerialRec
    Name As String
    NamePlayer As String * NAME_LENGTH

    Item As Long
    ItemValue As Long
End Type
```

*delete serial folder in server "/data/serial"

* * *

**you need to know**, this project or the serial code is valid only one time use only, after which the code is deleted in the list and remove …
if you do not want to delete it I would suggest removing this code

These two codes ... in **cmdClaim**
```

Call ClearSerial (a)
Call SendSaveSerial (a)

```

[Wortel Angels]

~~ill test it~~ :D thanks

Tested…
So now i can use the code more than one time :D First problem cleared
but
If i do it like this '        Call ClearSerial(a)
```
Private Sub cmdClaim_Click()
Dim a As Long
Dim n As String

For a = 1 To MAX_SERIAL_NUMBER 'or what ever you called it

    If txtClaim.text = Serial(a).Name Then
        SendSpawnItem Serial(a).Item, Serial(a).ItemValue
        CheckMapGetItem
'        Call ClearSerial(a)

        If Serial_Changed(a) Then
            Call SendSaveSerial(a)
        End If

        lblClaimStatus.Caption = "Status: [Erfolg] Item gesendet."

        Exit Sub
    End If

Next

lblClaimStatus.Caption = "Status: [Fehler] Falscher Code."
End Sub
```The code is deletet when i open the Serial window again…
And when i comment out the Call SendSaveSerial (a)
```
Private Sub cmdClaim_Click()
Dim a As Long
Dim n As String

For a = 1 To MAX_SERIAL_NUMBER 'or what ever you called it

    If txtClaim.text = Serial(a).Name Then
        SendSpawnItem Serial(a).Item, Serial(a).ItemValue
        CheckMapGetItem
'        Call ClearSerial(a)

        If Serial_Changed(a) Then
'            Call SendSaveSerial(a)
        End If

        lblClaimStatus.Caption = "Status: [Erfolg] Item gesendet."

        Exit Sub
    End If

Next

lblClaimStatus.Caption = "Status: [Fehler] Falscher Code."
End Sub
```Or delete it i cant save the serials :D the server stops and i got an message (The server does not work e.c.t e.c.t.)

[Jumbofile]

can this have multiple codes?

[PVJsquad]

if you want to make the code does not delete Serial
replace **cmdClaim** with this code
Private Sub cmdClaim_Click()
```
Dim a As Long
Dim n As String

For a = 1 To MAX_SERIAL_NUMBER 'or what ever you called it

    If txtClaim.text = Serial(a).Name Then
        SendSpawnItem Serial(a).Item, Serial(a).ItemValue
        CheckMapGetItem

        lblClaimStatus.Caption = "Status: [Success] Item Successfully Delivered."

        Exit Sub
    End If

Next

lblClaimStatus.Caption = "Status: [Failed] code is invalid or already in use."
End Sub
```
why you still with this code?
```
If Serial_Changed(a) Then
```delet it