Jump to content
Search In
  • More options...
Find results that contain...
Find results in...

[EO 2.0]Friend System Version 1.5


crzyone9584
 Share

Recommended Posts

So for the past few days, I've been working on a friend system. With some help and answers from other users I have finally got version 1 completed. What this system does will display your friends in a list box. Next to their name you will either have (online) or (Offline). This indicates that they are either online or offline.

This System has been updated to work with EO 2.0 Beta!

Features

* Add Friends
* Remove Friends
* Update who's online. This is done when you add a friend, remove a friend, or when someone logs in or off the server

Planned Features

* Show Friends Details. Such as level, if they are a PK, etc. - Finished in my game. Just need to transfer it to EO 2.0 to test.

Without further waiting here is the code.

Client Side Edits

modClientTCP - Add at the very bottom of the file.
```
'Crzy's Friends System
Public Sub AddFriend(ByVal FriendsName As String)
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteLong CAddFriend
    Buffer.WriteString FriendsName
    SendData Buffer.ToArray()
    Set Buffer = Nothing
End Sub

Public Sub RemoveFriend(ByVal FriendsName As String)
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteLong CRemoveFriend
    Buffer.WriteString FriendsName
    SendData Buffer.ToArray()
    Set Buffer = Nothing
End Sub

Public Sub UpdateFriendList()
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteLong CFriendsList
    SendData Buffer.ToArray
    Set Buffer = Nothing
End Sub
```
modConstents

Search for
```
Public Const SEX_FEMALE As Byte = 1
```
Underneath add
```
'Crzy's Friends System
Public Const MAX_FRIENDS As Byte = 50
```
modEnumerations - client named packets first them server named ones.

search for
```
' Make sure CMSG_COUNT is below everything else
    CMSG_COUNT
```
Right above the comment add
```
'Crzy's Friends System
    CFriendsList
    CAddFriend
    CRemoveFriend
```
Now search
```
' Make sure SMSG_COUNT is below everything else
    SMSG_COUNT
```
Right above the comments add
```
'Crzy's Friends System
    SFriendsList
```
modHandleData

Add the following at the end of Public Sub InitMessages(), before the end sub.
```
'Friends system
    HandleDataSub(SFriendsList) = GetAddress(AddressOf HandleFriendList)
```
At the very bottom of modHandledata Add
```
'Crzy's Friends System
Sub HandleFriendList(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim FriendsName As String
Dim AmountofFriends As Long
Dim I As Long

Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
AmountofFriends = Buffer.ReadLong

        'Prevents error and clears your friends list when you have no friends
        If AmountofFriends = 0 Then
            frmMain.lstFriend.Clear
            frmMain.lstFriend.AddItem "No Friends Online"
            Exit Sub
        End If

    'clear lstbox so it can be updated correctly.
    frmMain.lstFriend.Clear

    'Adds Friends Name to the List
    For I = 1 To MAX_FRIENDS
        FriendsName = Buffer.ReadString
            If FriendsName = " (OffLine)" Then
                GoTo Continue
            Else
                frmMain.lstFriend.AddItem FriendsName
            End If
Continue:
    Next

    If frmMain.lstFriend.ListCount = 0 Then
        frmMain.lstFriend.AddItem "No Friends Online"
    End If
End Sub

```
modTypes

Search for
```
Private Type PlayerRec
```
Right above add
```
Type FriendsListUDT
    FriendName As String
End Type
```
Search for (this should be within the PlayerRec.
```
' Client use only
```
Right Above add
```
'Crzy's Friends List
    Friends(1 To MAX_FRIENDS) As FriendsListUDT
    AmountofFriends As Long
```
Now open frmMain. Go into code view and add this at the very bottom of the file (Thanks to the first friend system tutorial for [EO] for the following code.
```
'Crzy's Friends System
Private Sub lblAddFriend_Click()
Dim n As Long
Dim strinput As String
        strinput = InputBox("Friend's Name : ", "Add Friend")
        If StrPtr(strinput) = 0 Or strinput = vbNullString Then Exit Sub

            Call AddFriend(Trim$(strinput))
End Sub

Private Sub lblRemoveFriend_Click()
Dim n As Long
Dim strinput As String
        strinput = InputBox("Friend's Name : ", "Add Friend")
        If StrPtr(strinput) = 0 Or strinput = vbNullString Then Exit Sub

            Call RemoveFriend(Trim$(strinput))
End Sub

Private Sub lblFriends_Click()
    friendslist.Visible = True
    picInventory.Visible = False
    picCharacter.Visible = False
    picSpells.Visible = False
    picOptions.Visible = False
End Sub
```
Double click all your menu buttons.(Settings, Character, Inventory, Skills + any custom ones you have added). And add the following in their click event

> friendslist.Visible = False

No get out of the code view of the frmMain and now we will start adding things to the gui. Copy and paste picInventory. When asked if you would like to make a control array say no. No rename it to friendslist. Inside friendslist add a listbox and name it lstFriend.

Make a new label and name it lblFriends. Double click and make sure it shows the following.
```
Private Sub lblFriends_Click()
    friendslist.Visible = True
    picInventory.Visible = False
    picCharacter.Visible = False
    picSpells.Visible = False
    picOptions.Visible = False
    UpdateFriendList

End Sub
```

The client side is now finished.

Server Side Edits

modConstants

Search for
```
Public Const SEX_FEMALE As Byte = 1
```
After add
```
'Crzy's Friends System
Public Const MAX_FRIENDS As Byte = 50
```
modHandledata

Inside the Sub InitMessages() before the End Sub add
```
'Crzy's Friends System
    HandleDataSub(CAddFriend) = GetAddress(AddressOf HandleAddFriend)
    HandleDataSub(CRemoveFriend) = GetAddress(AddressOf HandleRemoveFriend)
```
At the very bottom of the file add
```
'Crzy's Friends System

Sub HandleAddFriend(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddR As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim FriendName As String
Dim I As Long
Dim i2 As Long
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
FriendName = Buffer.ReadString
Set Buffer = Nothing

    'See if character exsists
    If FindChar(FriendName) = False Then
        Call PlayerMsg(Index, "Player doesn't exsist", Red)
        Exit Sub
    Else
        'Add Friend to List
        For I = 1 To MAX_FRIENDS
            If Player(Index).Friends(I).FriendName = vbNullString Then
                Player(Index).Friends(I).FriendName = FriendName
                Player(Index).AmountofFriends = Player(Index).AmountofFriends + 1
                Exit For
            End If
        Next
    End If

    'Update Friend List
    Call UpdateFriendsList(Index)
End Sub

Sub HandleRemoveFriend(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddR As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim FriendName As String
Dim I As Long
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
FriendName = Buffer.ReadString
Set Buffer = Nothing

    If FriendName = vbNullString Then Exit Sub

    For I = 1 To MAX_FRIENDS
        If Player(Index).Friends(I).FriendName = FriendName Then
            Player(Index).Friends(I).FriendName = vbNullString
            Player(Index).AmountofFriends = Player(Index).AmountofFriends - 1
            Exit For
        End If
    Next

    'Update Friend List
    Call UpdateFriendsList(Index)
End Sub

'Friends List
Sub UpdateFriendsList(Index)
Dim Buffer As clsBuffer
Dim FriendName As String
Dim tempName As String
Dim I As Long
Dim i2 As Long

    Set Buffer = New clsBuffer

    If Player(Index).AmountofFriends = 0 Then
        Buffer.WriteLong SFriendsList
        Buffer.WriteLong Player(Index).AmountofFriends
        GoTo Finish
    End If

    Buffer.WriteLong SFriendsList

    'Sends the amount of friends in friends list
    Buffer.WriteLong Player(Index).AmountofFriends

    'Check to see if they are Online
    For I = 1 To MAX_FRIENDS
        FriendName = Player(Index).Friends(I).FriendName
            For i2 = 1 To MAX_PLAYERS
                tempName = GetPlayerName(i2)
                    If tempName = FriendName And IsPlaying(i2) Then
                        Buffer.WriteString FriendName
                    End If
            Next
    Next
Finish:
    SendDataTo Index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub

```
modTypes

Search for
```
Private Type PlayerRec
```
Right above it add
```
'Crzy's Friend System
Type FriendsListUDT
    FriendName As String
End Type
```
Search for should be right before End Type for Player Rec
```
Dir As Byte
```

Right below it add
```
'Crzy's Friends List
    Friends(1 To MAX_FRIENDS) As FriendsListUDT
    AmountofFriends As Long
```
modEnumerations

Search for
```
' Make sure SMSG_COUNT is below everything else
```
Right above add
```
'Crzy's Friends List
    SFriendsList
```
Search for
```
' Make sure CMSG_COUNT is below everything else
```
Right above it add
```
'Crzy's Friends System
    CFriendsList
    CAddFriend
    CRemoveFriend
```
Now delete all the user's files in the server. Located at /data/accounts. Delete all player files. Open up charlist and delete all the names and save. To my understanding when something is added to the PlayerRec you will have to have your players resign up so their file will hold the new information.

Server edits are now complete.

If you find a bug or have any issues, please post here. I will always give support for my official released Systems. Also enjoy my friend system.

Known Bugs
None
Link to comment
Share on other sites

  • Replies 100
  • Created
  • Last Reply

Top Posters In This Topic

@Vitin:

> To the autoupdating thing make it so in the server , when a player logs in it checks in every online player if the have the player who just joined as friend and if yes send the friends list.

Tried that. for some reason it adds 2 offline and 1 online for the user. Its a bug/coding error. I'm still trying to fix it. I released the code so other could have it and also for when they try it they can post what fixed the bug for them. I've been working on this single feature for over a week now. Not sure how I'm going to fix it.

All checks to see if a user is online or not is on the server side.
Link to comment
Share on other sites

The following peices of code have been updated for the bug. How it works now is if there are no friends online you will see "No Friends Online" instead of the username. If they are online you will their name.

* * *

On the server side in modServerTCP

Search for HandleUpdateFriendsList. Replace entire sub with
```
Sub UpdateFriendsList(Index)
Dim Buffer As clsBuffer
Dim FriendName As String
Dim tempChar As String
Dim tempName As String
Dim I As Long
Dim i2 As Long

    Set Buffer = New clsBuffer

    If Player(Index).AmountofFriends = 0 Then
        Buffer.WriteLong SFriendsList
        Buffer.WriteLong Player(Index).AmountofFriends
        GoTo Finish
    End If

    Buffer.WriteLong SFriendsList

    'Sends the amount of friends in friends list
    Buffer.WriteLong Player(Index).AmountofFriends

    'Check to see if they are Online
    For I = 1 To MAX_FRIENDS
        FriendName = Player(Index).Friends(I).FriendName
            For i2 = 1 To MAX_PLAYERS
                tempName = GetPlayerName(i2)
                    If tempName = FriendName And IsPlaying(i2) Then
                        Buffer.WriteString FriendName
                    End If
            Next
    Next
Finish:
    SendDataTo Index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub
```
on client side in modHandleData Search for HandleFriendList. Replace entire sub with
```
Sub HandleFriendList(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim FriendsName As String
Dim AmountofFriends As Long
Dim x As Integer
Dim I As Long

Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
AmountofFriends = Buffer.ReadLong

        'Prevents error and clears your friends list when you have no friends
        If AmountofFriends = 0 Then
            frmMain.lstFriend.Clear
            frmMain.lstFriend.AddItem "No Friends Online"
            Exit Sub
        End If

    'clear lstbox so it can be updated correctly.
    frmMain.lstFriend.Clear

    'Adds Friends Name to the List
    For I = 1 To MAX_FRIENDS
        FriendsName = Buffer.ReadString
            If FriendsName = " (OffLine)" Then
                GoTo Continue
            Else
                frmMain.lstFriend.AddItem FriendsName
            End If
Continue:
    Next

    If frmMain.lstFriend.ListCount = 0 Then
        frmMain.lstFriend.AddItem "No Friends Online"
    End If
End Sub
```

* * *

All bugs from the first version are fixed. Next version will include player information. I've also updated the first post with the bug fixes.
Link to comment
Share on other sites

Not until I get a better computer. The computer i'm on right now can hardly handle google chrome and vb6…. stupid old computers. When I push out the update to kinjiru's game, I'll have somebody take a screen shot of no one online, adding, removing, and all the other features. Unless I'm able to play it at school next tuesday. I may be able to get some snap shots.
Link to comment
Share on other sites

  • 2 weeks later...
So nothing to badly changed from my version to the newest version. Thats good to know. This weekend I'll be updating it to include my new features

The short mail system is not part of the friends system. But I will release it for those who would like it.

Features that are completed in from the first post
*Show friends info
*Update friends list when someone enters and or leaves the game

All new code will be available by sunday.

Skip to the end of the video. I haven't had time to make a video solely for the friend system.

http://www.youtube.com/watch?v=LaJlzPD1fKg
Link to comment
Share on other sites

  • 2 weeks later...
@crzyone9584:

> The short mail system is not part of the friends system. But I will release it for those who would like it.

An EO compatible version to the one in ES: http://www.touchofdeathforums.com/smf/index.php/topic,50294.msg524602.html

Thanks Crzy, You had more patience with it than I did x_x
Link to comment
Share on other sites

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 account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share


×
×
  • Create New...