Friend's List

[The Oracle]

yeah, ima add winsock to that soon to make it so each character has diffrent friends. Hopefully i have enough time on monday. I dont want to let you all down. =/

[Guest]

but that feature is kinda kool, keep it, or have a choice to keep it or not

[The Oracle]

it's like endless online. it sucked cause you could never remember each others names exactly and you always use a diffrent comp. =/.

[Guest]

that would be a prob…hmmm

[AfterDawn]

update?

[The Oracle]

i MAY update it, but it would be very unlikley. XD

once i finish slym's project ill probably get around to this

[AfterDawn]

ok, i guess i'll just visit every now and then.

[Kimimaru]

Editing out code; figured it out!

[The Oracle]

o_O wow. looks like you put a lot of time into "reviving" my old code. I'll be glad to help you out, although the reason i abandoned the old code is because i didn't want to make it server side because I blow at winsock. >_<

anyways, ill take a look at it and thanks a lot for reworking this. God knows I wouldn't have put the time in to. XD

[Kimimaru]

No problem. I have to thank you for the original code, though. If you plan on helping, I just need help getting the Client to properly read the values from the INI file in the Server.

[Skillzalot]

Its about time this was revived. I am so looking forward to those new updates

[The Oracle]

Again, i cant do shit with winsock but wouldn't it have to be the same casestring? like this:

```
'Gets Player Friend Lists

    Call SendData("caption1" & END_CHAR)
    Call SendData("caption2" & END_CHAR)
    Call SendData("caption3" & END_CHAR)
    Call SendData("caption4" & END_CHAR)
    Call SendData("caption5" & END_CHAR)
    Call SendData("caption6" & END_CHAR)
    Call SendData("caption7" & END_CHAR)
    Call SendData("caption8" & END_CHAR)
    Call SendData("caption9" & END_CHAR)
    Call SendData("caption10" & END_CHAR)
```
In the original code, you used getcaption#, where in the rest of the code you used caption#. i THINK this will work. idk test it out

[Kimimaru]

I appreciate the attempt, but no, it doesn't have to be the same casestring.

The "caption" packets are used for storing the data in the Server. On **Sub Form_Load()** in **frmMirage**, it's supposed to load the data. I use the "getcaption" packets to help do just that.

Here's what happens after frmMirage sends the "getcaption" packets. We'll use "getcaption1" as an example:

In **modHandleData** in the Server, it does this:

```
Case "getcaption1"
            Call SendDataTo(Index, "caption1" & SEP_CHAR & GetVar(App.Path & "\Accounts\" & "Friend Lists.ini", GetPlayerName(Index), "1") & END_CHAR)
            Exit Sub

```
What does this do? It sends a packet back to the Client with the name of the player on the friends list in slot 1\. The name of the player is obtained from the INI file. The name of the packet it sends is "caption1."

Where does this packet go? It gets sent to **modHandleData** in the Client. Now, it must handle that packet. I chose to do it like this:

```
    ' :::::::::::::::::::::::::::
    ' :: Friends List Packet 1 ::
    ' :::::::::::::::::::::::::::
    If casestring = "caption1" Then
        frmMirage.lblFriend1.Caption = Trim(parse(1))
        Exit Sub
    End If

```
This replaces the caption of lblFriend1 with the friend whose name is in slot 1 of the friends list. Why doesn't this work? I don't know.

[manbearpig]

this needs like online players and stuff.

[Kimimaru]

I've finally fixed it!!!!! After so long, I've finally figured out how to fix my code!! You guys have no idea how happy I am right now, lol. I'll post up the fixed version later when I have more time!

[Kimimaru]

EDIT (9/26/09): Arrayed labels and re-wrote the entire code in very few lines as opposed to the amount of code before.

This is the fixed up Friends List that I've managed to fix up myself. I've fixed it up before, but I was encountering a small problem with it, and I've only just fixed that small problem very recently. Different accounts and characters on the same computer will have different friends.

The fixes and additions to the old code will be explained at the end of the post.

Let's start with the **Client**. Open up the **Client** in VB6 and open up **frmMirage**.

The first thing we need to do is create the necessary objects:

1) Create a PictureBox and place it wherever you want on **frmMirage**. Name it picFriendList.
2) Place **1** label inside the PictureBox. Name it lblFriend.
3) Left-click on the label so that you're selected on it. Hold **Ctrl** and then press **C** so that you copy it.
4) Click inside the PictureBox, and then hold **Ctrl** and then press **V** so that you paste it.
5) It will basically ask you if you want to make this label part of an array. Choose the "Yes" option.
6) Repeat step 4 until you have 10 **labels** inside the PictureBox. Please note that you will have to click inside the PictureBox again each time you copy and paste another label.
7) Inside the PictureBox, create 3 CommandButtons. Name them: cmdHide, cmdAdd, and cmdDelete.
8) Create yet another CommandButton wherever you want on **frmMirage** and name it: cmdFriendList.
9) Finally, create a TextBox inside the PictureBox, and name it **txtFriend**.

That's all for the objects! Now let's get into that code!

Double-click on **cmdHide**. Make its Sub look like this:

```
Private Sub cmdHide_Click()
    picFriendList.Visible = False
End Sub
```
Look for **cmdFriendList**. Make sure you double-click on it to make its code pop up, and then change its Sub to look like this:

```
Private Sub cmdFriendList_Click()
    picFriendList.Visible = True
'Finds out if players are online or not
    Call SendData("friendonlineoffline" & SEP_CHAR & lblFriend(Index).Caption & SEP_CHAR & Index & END_CHAR)

End Sub
```
Now double-click on **cmdAdd**. Change its Sub to look like this:

```
Private Sub cmdAdd_Click()
Dim i As Integer

For i = 0 To 8
  If LenB(lblFriend(i).Caption) < 2 Then
      lblFriend(i).Caption = txtFriend.Text
      txtFriend.Text = vbNullString
      Call SendData("caption" & SEP_CHAR & lblFriend(i).Caption & SEP_CHAR & i & END_CHAR)
  ElseIf LenB(lblFriend(i).Caption) >= 2 And LenB(lblFriend(i + 1).Caption) < 2 Then
      lblFriend(i + 1).Caption = txtFriend.Text
      txtFriend.Text = vbNullString
      Call SendData("caption" & SEP_CHAR & lblFriend(i + 1).Caption & SEP_CHAR & Int(i + 1) & END_CHAR)
  End If
Next i

End Sub
```
After that's done, find **cmdDelete**. Double-click on it to open up it's code, and change its Sub to look like this:

```
Private Sub cmdDelete_Click()
Dim i As Integer

For i = 0 To 9
  If lblFriend(i).Caption = txtFriend.Text Then
    lblFriend(i).Caption = vbNullString
    Call SendData("caption" & SEP_CHAR & lblFriend(i).Caption & SEP_CHAR & i & END_CHAR)
    txtFriend.Text = vbNullString
  End If
Next i

End Sub
```
Now we're done with the buttons!  :cheesy: Unfortunately, that's not all, though.

In the **frmMirage** code, double-click on any label in your **picFriendList** PictureBox to pull up its code.

Change it to look like this:

```
Private Sub lblFriend_Click(Index As Integer)
    If lblFriend(Index).Caption <> vbNullString Then
        Call SendPlayerChat(Trim$(lblFriend(Index).Caption))
    End If
End Sub
```
It doesn't matter which label you choose because clicking on any of the labels brings up the same code.

In the **frmMirage** code, find this:

```
Private Sub Form_Load()
    Dim i As Long
    Dim Ending As String
```
Anywhere in that Sub, add this:

```
picFriendList.Visible = False
```
Now we're done with **frmMirage!** We still have a little more to do in the **Client**, though, so open up **modHandleData**.

Find this:

```
' if a player left the game
    If casestring = "left" Then
        Call ClearPlayer(parse(1))
        Exit Sub
    End If
```
Directly underneath that, put all of this:

```
    ' ::::::::::::::::::::::::::
    ' :: Friend Status Packet ::
    ' ::::::::::::::::::::::::::
    If casestring = "friendstatus" Then
      Dim Q As Integer
        i = Val(parse(1))
        Q = Int(parse(2))
      If i = 0 Then
            frmMirage.lblFriend(Q).ForeColor = &HFF&
      ElseIf i <> 0 Then
            frmMirage.lblFriend(Q).ForeColor = &H8080&
      End If
      Exit Sub
    End If

    ' :::::::::::::::::::::::::
    ' :: Friends List Packet ::
    ' :::::::::::::::::::::::::
    If casestring = "caption" Then
    Dim f As Integer
    Dim g As Integer
      f = Int(parse(2))
        frmMirage.lblFriend(f - 1).Caption = Trim(parse(1))
        Exit Sub
    End If
```
We're done with **modHandleData**.  :azn: Look for **modGameLogic** and open it up. Find this:

```
Function FindPlayer(ByVal Name As String) As Long
    Dim i As Long

    For i = 1 To MAX_PLAYERS
        If IsPlaying(i) Then
            ' Make sure we dont try to check a name thats to small
            If Len(GetPlayerName(i)) >= Len(Trim$(Name)) Then
                If UCase$(Mid$(GetPlayerName(i), 1, Len(Trim$(Name)))) = UCase$(Trim$(Name)) Then
                    FindPlayer = i
                    Exit Function
                End If
            End If
        End If
    Next i

    FindPlayer = 0
End Function
```
Replace it with this:

```
Function FindPlayer(ByVal Name As String) As Long
    Dim i As Long

    For i = 1 To MAX_PLAYERS
        If IsPlaying(i) Then
            ' Make sure we dont try to check a name thats to small
            If Len(GetPlayerName(i)) >= Len(Trim$(Name)) Then
                If UCase$(Trim$(GetPlayerName(i))) = UCase$(Trim$(Name)) Then
                    FindPlayer = i
                    Exit Function
                End If
            End If
        End If
    Next i

    FindPlayer = 0
End Function
```
This fixes up a small bug in the online/offline friends.

That should be all for the **Client**!

Now please make sure you open up the **Server** in VB6.

Bring up **modHandleData**. Find this:

```
Sub HandleData(ByVal index As Long, ByVal Data As String)
    Dim Parse() As String
```
Change it to look like this:

```
Sub HandleData(ByVal index As Long, ByVal Data As String)
    Dim Parse() As String
    Dim I As Long
```
Also, find this:

```
Case "getclasses"
            Call Packet_GetClasses(index)
            Exit Sub
```
Under that, add this:

```
        Case "friendonlineoffline"
          Dim Q
            I = FindPlayer(Parse(1))
            Q = Int(Parse(2))
                Call SendDataTo(Index, "friendstatus" & SEP_CHAR & I & SEP_CHAR & Q & END_CHAR)
            Exit Sub

        Case "caption"
        I = Parse(2)
            Call PutVar(App.Path & "\Accounts\" & "Friend Lists.ini", GetPlayerName(Index), CStr(I + 1), Trim(Parse(1)))
            Exit Sub
```
That's all for **modHandleData** on the **Server** side!

Stay with me; we're almost done!

Open up **modGameLogic** and find this whole Sub:

```
Public Sub JoinGame(ByVal Index As Long)
    Dim MOTD As String

    ' Set the flag so we know the person is in the game
    Player(Index).InGame = True

    ' Send an ok to client to start receiving in game data
    Call SendDataTo(Index, "loginok" & SEP_CHAR & Index & END_CHAR)

    ReDim Player(Index).Party.Member(1 To MAX_PARTY_MEMBERS)

    Call CheckEquippedItems(Index)
    Call SendClasses(Index)
    Call SendItems(Index)
    Call SendEmoticons(Index)
    Call SendElements(Index)
    Call SendArrows(Index)
    Call SendNpcs(Index)
    Call SendShops(Index)
    Call SendSpells(Index)
    Call SendInventory(Index)
    Call SendBank(Index)
    Call SendHP(Index)
    Call SendMP(Index)
    Call SendSP(Index)
    Call SendPTS(Index)
    Call SendStats(Index)
    Call SendWeatherTo(Index)
    Call SendTimeTo(Index)
    Call SendGameClockTo(Index)
    Call DisabledTimeTo(Index)
    Call SendSprite(Index, Index)
    Call SendPlayerSpells(Index)
    Call SendOnlineList

    ' Warp the player to his saved location
    Call PlayerWarp(Index, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))

    If SCRIPTING = 1 Then
        MyScript.ExecuteStatement "Scripts\Main.txt", "JoinGame " & Index
    Else
        ' Send a global message that he/she joined.
        If GetPlayerAccess(Index) = 0 Then
            Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 7)
        Else
            Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 15)
        End If

        Call PlayerMsg(Index, "Welcome to " & GAME_NAME & "!", 15)

        ' Send the player the welcome message.
        MOTD = Trim$(GetVar(App.Path & "\MOTD.ini", "MOTD", "Msg"))
        If LenB(MOTD) <> 0 Then
            Call PlayerMsg(Index, "MOTD: " & MOTD, 11)
        End If

        ' Update all clients with the player.
        Call SendWhosOnline(Index)
    End If

    ' Tell the client the player is in-game.
    Call SendDataTo(Index, "ingame" & END_CHAR)

    ' Update the server console.
    Call ShowPLR(Index)

End Sub
```
Replace the entire Sub with this:

```
Public Sub JoinGame(ByVal Index As Long)
    Dim MOTD As String
    Dim I As Integer

    ' Set the flag so we know the person is in the game
    Player(Index).InGame = True

    ' Send an ok to client to start receiving in game data
    Call SendDataTo(Index, "loginok" & SEP_CHAR & Index & END_CHAR)

    ReDim Player(Index).Party.Member(1 To MAX_PARTY_MEMBERS)

    Call CheckEquippedItems(Index)
    Call SendClasses(Index)
    Call SendItems(Index)
    Call SendEmoticons(Index)
    Call SendElements(Index)
    Call SendArrows(Index)
    Call SendNpcs(Index)
    Call SendShops(Index)
    Call SendSpells(Index)
    Call SendInventory(Index)
    Call SendBank(Index)
    Call SendHP(Index)
    Call SendMP(Index)
    Call SendSP(Index)
    Call SendPTS(Index)
    Call SendStats(Index)
    Call SendWeatherTo(Index)
    Call SendTimeTo(Index)
    Call SendGameClockTo(Index)
    Call DisabledTimeTo(Index)
    Call SendSprite(Index, Index)
    Call SendPlayerSpells(Index)
    Call SendOnlineList

    ' Warp the player to his saved location
    Call PlayerWarp(Index, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))

    If SCRIPTING = 1 Then
        MyScript.ExecuteStatement "Scripts\Main.txt", "JoinGame " & Index
    Else
        ' Send a global message that he/she joined.
        If GetPlayerAccess(Index) = 0 Then
            Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 7)
        Else
            Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", 15)
        End If

        Call PlayerMsg(Index, "Welcome to " & GAME_NAME & "!", 15)

        ' Send the player the welcome message.
        MOTD = Trim$(GetVar(App.Path & "\MOTD.ini", "MOTD", "Msg"))
        If LenB(MOTD) <> 0 Then
            Call PlayerMsg(Index, "MOTD: " & MOTD, 11)
        End If

        ' Update all clients with the player.
        Call SendWhosOnline(Index)
    End If

    ' Tell the client the player is in-game.
    Call SendDataTo(Index, "ingame" & END_CHAR)

    ' Update the server console.
    Call ShowPLR(Index)

    ' Welcome new players

    If GetVar(App.Path & "\Accounts\" & "WelcomeMsg.ini", GetPlayerName(Index), "WelcomeMsg") = vbNullString Then
        Call SendDataTo(Index, "welcomemsg" & END_CHAR)
    End If

    ' Loads Friends Lists
    For I = 1 To 10
        Call SendDataTo(Index, "caption" & SEP_CHAR & Trim(GetVar(App.Path & "\Accounts\" & "Friend Lists.ini", GetPlayerName(Index), CStr("" & I & ""))) & SEP_CHAR & I & END_CHAR)
    Next I

End Sub
```
That's everything! I hope I didn't forget anything.  XD

For me, this works very well and has no flaws or errors. If anyone happens to come by any, please post it on here, and I'll look into it. Also, if anyone feels that I forgot something because the code doesn't work for you, then also please post on here.

I don't want The Fleshlightman to feel like I'm taking over this topic; I'm just posting a fix to his code.

Fixes to old code:
-Changed open quotation marks ("") to **vbNullString**. This allows the commands to be processed faster.
-Fixed up the **cmdDelete** code. Before, it didn't delete anything from any INI file; it just removed the caption.
-Arrayed the labels so that the code can be written in an ENORMOUSLY less amount of code

Additions to old code:
-Made it so that you cannot send a chat request to a friend that doesn't exist on the friends list.
-Made the text for **txtFriend** get cleared after you delete a friend. Before, it remained as whatever you typed in last.
-Of course, allowed different characters and accounts to have different friends. The same computer, same friends rule no longer exists.
-Added in online/offline recognition for friends. Online friends will have their username in green, and offline friends will have their username in red.

While I was making this, I was planning on implementing a cool feature to this. Since I've been coding for a few hours now, and I'm pretty sick of it right now, I've decided to scrap this idea.

**Scrapped idea:**
-Not allowing you to type in the name of a non-existant character. For example, if you typed in "fjdhfd," and no one has ever created a character with that name, a box would pop up, notifying you that you cannot add that person because that character name does not exist.

A little note on this: I know how to get this to work, and I've actually gotten some part of it to work successfully. After I finished that, though, I realized that it was a little more work than I expected, so I dropped the idea. _**If you want this on your friends list, I can remake the code and post it on here for everyone.**_

**Thanks**

Thanks goes to The Fleshlightman for the original code. Tremendous thanks goes to GodLord for basically teaching me how to use packets when I posted a problem that you needed to use packets to solve. Additional thanks goes to GodLord for fixing up the small online/offline friends bug and suggesting to array my labels (Zetta Monkey proposed this idea as well). Extra thanks goes to Robin for helping fix up the online/offline recognition. It wasn't working properly before.

**Credit**

You do not need to credit me at all if you choose to use my code in your game. If The Fleshlightman chooses to add my code to his first post, the only credit I ask for is that he writes that the code was fixed up by me.

Enjoy the code! Please remember to report any problems you encounter with it!

[The New World]

One thing..

```
Private Sub lblFriend9_Click()
If lblFriend9.Caption <> vbNullString Then
Call SendPlayerChat(Trim$(lblFriend9.Caption))
End If
End Sub

```
Shouldn't there be a 10?

[Godlord]

**Protip**: use the 'Index'-property, it allows you to have an array of labels. See the socket object in the Server for more information.

Regards,
  Godlord.

[The New World]

~~No Select Case~~ ```
Case "caption1"
            Call PutVar(App.Path & "Accounts" & "Friend Lists.ini", GetPlayerName(Index), "1", Trim(Parse(1)))
            Exit Sub

```
Lol, my bad. Fixed it ^^

[Godlord]

Why in the hell would you use Select Case when Array Objects can do it way faster and with less code?

Regards,
  Godlord.

[The New World]

@Godlord:

> Why in the hell would you use Select Case when Array Objects can do it way faster and with less code?
>
> Regards,
>   Godlord.

~~I'm just finishing it to have a complete code, then I'm optimizing it. But I can't compile this code without a select case.~~

Fixed it, optimizing it =]

[Homicidal Monkey]

might I suggest arraying your labels or whatever that object was?

[Godlord]

@Rose:

> ~~I'm just finishing it to have a complete code, then I'm optimizing it. But I can't compile this code without a select case.~~
>
> Fixed it, optimizing it =]

You can live without Select Case completely in this case. Use For Loops and Arrays.

Regards,
  Godlord.

[The New World]

@Godlord:

> You can live without Select Case completely in this case. Use For Loops and Arrays.
>
> Regards,
>   Godlord.

I realized.

[Kimimaru]

@Rose:

> One thing..
>
> ```
> Private Sub lblFriend9_Click()
> If lblFriend9.Caption <> vbNullString Then
> Call SendPlayerChat(Trim$(lblFriend9.Caption))
> End If
> End Sub
>
> ```
> Shouldn't there be a 10?

There is one. It's located right after the **Private Sub lblFriend1_Click()**.

As for Arrays, I don't know how to use them in VB6\. I know how to use them in Java, though.