Chat Room System

[abhi2011]

**Chat Room System**

Hey guys another tutorial. Might be my 5th. Don't remeber correctly.

What this does is allows players to join a Chat Room where they can chat. It's just basic allowing players to create, join, and leave. Along with a few other good parts.

**How does it work?**

Players create chats by using "/createchat (name)"

Players join chats by using "/joinchat (name)"

Players leave chats by using "/leavechat"

Players get players in chat using "/chatwho"

Chat Commands info = "/chathelp"

Chat using @

>! [](http://www.freemmorpgmaker.com/files/imagehost/#13111b103d22a5d1f07f04b77426eaab.PNG)

**Client Side**

**modEnumerations:**

Before

```

' Make sure SMSG_COUNT is below everything else

SMSG_COUNT

```
Add

```

'Chat Room Packets

SChatMsg

'/Chat room Packets

```
Before

```

' Make sure CMSG_COUNT is below everything else

CMSG_COUNT

```
Add

```

'Chat Room Packets

CCreateChat

CJoinChat

CWhoChat

CChatMsg

CLeaveChat

'/Chat Room packets

```

**modHandleData:**

In sub

```

InitMessages()

```
At the bottom add

```

HandleDataSub(SChatMsg) = GetAddress(AddressOf HandleChatMsg)

```
And the end of the module add the following sub:

```

Private Sub HandleChatMsg(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddR As Long, ByVal ExtraVar As Long)

Dim msg As String, color As Long

Dim Buffer As clsBuffer

' If debug mode, handle error then exit out

If Options.Debug = 1 Then On Error GoTo ErrorHandler

Set Buffer = New clsBuffer

Buffer.WriteBytes Data()

msg = Buffer.ReadString

color = Buffer.ReadLong

Call AddText(msg, color)

' Error handler

Exit Sub

ErrorHandler:

HandleError "HandleMapmsg", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext

Err.Clear

Exit Sub

End Sub

```
**modInput:**

Below

```

' Broadcast message

If Left$(chatText, 1) = "'" Then

chatText = Mid$(chatText, 2, Len(chatText) - 1)

If Len(chatText) > 0 Then

Call BroadcastMsg(chatText)

End If

MyText = vbNullString

UpdateShowChatText

Exit Sub

End If

```
add

```

' Chat Msg

If Left$(chatText, 1) = "@" Then

chatText = Mid$(chatText, 2, Len(chatText) - 1)

If Len(chatText) > 0 Then

Call SendChatMsg(chatText)

End If

MyText = vbNullString

UpdateShowChatText

Exit Sub

End If

```
Below

```
Call AddText("Available Commands: /who, /fps, /fpslock, /gui, /maps", HelpColor)
```
Add

```
Call AddText("For Chat room command help: /chathelp", HelpColor)
```
In the same sub find this:

```

Case "/stats"

Set Buffer = New clsBuffer

Buffer.WriteLong CGetStats

SendData Buffer.ToArray()

Set Buffer = Nothing

```
Bellow add

```

' Chat Room Commands

Dim chatname As String

' help

Case "/chathelp"

Call AddText("Chat Commands: ", HelpColor)

Call AddText("Create Chat: /createchat (room name)", HelpColor)

Call AddText("Join Chat: /joinchat (room name)", HelpColor)

Call AddText("Players in chat: /chatwho", HelpColor)

Case "/createchat"

If Trim$(UBound(Command)) < 1 Then

AddText "Usage: /chatcreate (room name)", AlertColor

GoTo continue

End If

For I = 1 To Trim$(UBound(Command))

If Not I = 0 Then

chatname = chatname & " " & Command(I)

End If

Next

SendCreateChat chatname

Case "/joinchat"

If UBound(Command) < 1 Then

AddText "Usage: /joinchat (room name)", AlertColor

GoTo continue

End If

For I = 1 To UBound(Command)

If Not I = 0 Then

chatname = chatname & " " & Command(I)

End If

Next

SendJoinChat chatname

Case "/leavechat"

SendLeaveChat

Case "/chatwho"

SendWhoChat

```

**modClientTCP:**

At the end of the sub add this

```

'Chat Room

Public Sub SendCreateChat(ByVal Name As String)

Dim Buffer As clsBuffer

Set Buffer = New clsBuffer

Buffer.WriteLong CCreateChat

Buffer.WriteString Name

SendData Buffer.ToArray

Set Buffer = Nothing

End Sub

Public Sub SendJoinChat(ByVal Name As String)

Dim Buffer As clsBuffer

Set Buffer = New clsBuffer

Buffer.WriteLong CJoinChat

Buffer.WriteString Name

SendData Buffer.ToArray

Set Buffer = Nothing

End Sub

Public Sub SendWhoChat()

Dim Buffer As clsBuffer

Set Buffer = New clsBuffer

Buffer.WriteLong CWhoChat

SendData Buffer.ToArray

Set Buffer = Nothing

End Sub

Public Sub SendChatMsg(ByVal message As String)

Dim Buffer As clsBuffer

Set Buffer = New clsBuffer

Buffer.WriteLong CChatMsg

Buffer.WriteString message

SendData Buffer.ToArray

Set Buffer = Nothing

End Sub

Public Sub SendLeaveChat()

Dim Buffer As clsBuffer

Set Buffer = New clsBuffer

Buffer.WriteLong CLeaveChat

SendData Buffer.ToArray

Set Buffer = Nothing

End Sub

```

**Server Side:**

**modEnumerations:**

Before

```

' Make sure SMSG_COUNT is below everything else

SMSG_COUNT

```
Add

```

'Chat Room Packets

SChatMsg

'/Chat room Packets

```
Before

```

' Make sure CMSG_COUNT is below everything else

CMSG_COUNT

```
Add

```

'Chat Room Packets

CCreateChat

CJoinChat

CWhoChat

CChatMsg

CLeaveChat

'/Chat Room packets

```

**modHandleData:**

In sub

```

InitMessages()

```
Add

```

' Chat Room

HandleDataSub(CCreateChat) = GetAddress(AddressOf HandleChatCreate)

HandleDataSub(CJoinChat) = GetAddress(AddressOf HandleChatJoin)

HandleDataSub(CWhoChat) = GetAddress(AddressOf HandleChatWho)

HandleDataSub(CChatMsg) = GetAddress(AddressOf HandleChatMsg)

HandleDataSub(CLeaveChat) = GetAddress(AddressOf HandleChatLeave)

' /chat room

```

And the end of the module add the following subs:

```

Public Sub HandleChatCreate(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim chatName As String

Dim Buffer As clsBuffer

' checks

If TempPlayer(index).inRoom Then

PlayerMsg index, "You already are in a Chat Room. Please leave the current Room and try again.", AlertColor

Exit Sub

End If

Set Buffer = New clsBuffer

Buffer.WriteBytes Data()

chatName = Buffer.ReadString

Call CreateChat(chatName, index)

Set Buffer = Nothing

End Sub

Public Sub HandleChatJoin(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim chatName As String

Dim Buffer As clsBuffer

' checks

If TempPlayer(index).inRoom Then

PlayerMsg index, "You already are in a Chat Room.", AlertColor

Exit Sub

End If

Set Buffer = New clsBuffer

Buffer.WriteBytes Data()

chatName = Buffer.ReadString

Call JoinChat(chatName, index)

Set Buffer = Nothing

End Sub

Public Sub HandleChatWho(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim i As Long

Dim n As Long

Dim s As String

If Not TempPlayer(index).inRoom Then

PlayerMsg index, "You are not in a chat room.", AlertColor

Exit Sub

End If

For i = 1 To Player_HighIndex

If IsPlaying(i) Then

If i <> index Then

s = s & GetPlayerName(i) & ", "

n = n + 1

End If

End If

Next

If n = 0 Then

s = "There are no other players online in" & ChatRoom(TempPlayer(index).roomIndex).Name & "."

Else

s = Mid$(s, 1, Len(s) - 2)

s = "There are " & n & " other players in '" & ChatRoom(TempPlayer(index).roomIndex).Name & "' : " & s & "."

End If

Call PlayerMsg(index, s, WhoColor)

End Sub

Public Sub HandleChatMsg(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim Msg As String, Buffer As clsBuffer, s As String, i As Long

If TempPlayer(index).inRoom = False Then

PlayerMsg index, "You are not in a chat room.", AlertColor

Exit Sub

End If

' Prevent hacking

For i = 1 To Len(Msg)

If AscW(Mid$(Msg, i, 1)) < 32 Or AscW(Mid$(Msg, i, 1)) > 126 Then

Exit Sub

End If

Next

Set Buffer = New clsBuffer

Buffer.WriteBytes Data()

Msg = Buffer.ReadString

s = "[" & ChatRoom(TempPlayer(index).roomIndex).Name & "] " & GetPlayerName(index) & ": " & Msg

ChatRoomMsg TempPlayer(index).roomIndex, s, Blue

End Sub

Public Sub HandleChatLeave(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

If TempPlayer(index).inRoom Then

LeaveChat (index)

Else

PlayerMsg index, "You are not in a chat room.", AlertColor

End If

End Sub

```

**modServerTCP:**

Find this sub:

```

Sub CloseSocket(ByVal index As Long)

```
Replace it with

```

Sub CloseSocket(ByVal index As Long)

'chat room

If TempPlayer(index).roomIndex > 0 Then

If ChatRoom(TempPlayer(index).roomIndex).Members - 1 = 0 Then

RemoveChat (TempPlayer(index).roomIndex)

End If

End If

If index > 0 Then

Call LeftGame(index)

If GetPlayerIP(index) <> "69.163.139.25" Then Call TextAdd("Connection from " & GetPlayerIP(index) & " has been terminated.")

frmServer.Socket(index).Close

Call UpdateCaption

'chat room

Call ClearPlayer(index)

End If

End Sub

```
**NOTE: This is for clearing the chat room index and members and name so that a new chat room can take it's place.**

Underneath this sub:

```

Public Sub MapMsg(ByVal mapnum As Long, ByVal Msg As String, ByVal color As Byte)

```
Add

```

Public Sub ChatRoomMsg(ByVal roomIndex As Long, ByVal Msg As String, ByVal color As Byte)

Dim Buffer As clsBuffer

Dim i As Long

Set Buffer = New clsBuffer

Buffer.WriteLong SChatMsg

Buffer.WriteString Msg

Buffer.WriteLong color

For i = 1 To MAX_PLAYERS

If IsPlaying(i) Then

If TempPlayer(i).inRoom Then

If TempPlayer(i).roomIndex = roomIndex Then

SendDataTo i, Buffer.ToArray

End If

End If

End If

Next

Set Buffer = Nothing

End Sub

```

**modDatabase:**

At the bottom of the sub add

```

Sub CreateChat(ByVal Name As String, ByVal index As Long)

Dim i As Long

' Find chats with similar name

for i = 1 to max_rooms

if chatroom(i).name = name then

playermsg index, "Chat room with given name already exists."

exit sub

end if

next

For i = 1 To MAX_ROOMS

If Not ChatRoom(i).index = vbNull Then

ChatRoom(i).index = i

ChatRoom(i).Name = Name

ChatRoom(i).Members = 1

TempPlayer(index).inRoom = True

TempPlayer(index).roomIndex = i

PlayerMsg index, "Your chat room '" & Name & "' has been created.", Blue

Exit For

End If

Next

End Sub

Sub JoinChat(ByVal Name As String, ByVal index As Long)

Dim i As Long

Dim s As Byte

For i = 1 To MAX_ROOMS

If ChatRoom(i).Name = Name Then

ChatRoom(i).Members = ChatRoom(i).Members + 1

TempPlayer(index).inRoom = True

TempPlayer(index).roomIndex = i

PlayerMsg index, "Joined chat room '" & Name & "' successfully.", Blue

s = 1

Exit For

End If

Next

If s = 0 Then

PlayerMsg index, "The Chat Room '" & Name & "' doesn't exist.", AlertColor

End If

End SubSub RemoveChat(ByVal index As Long)

With ChatRoom(index)

.index = 0

.Members = 0

.Name = vbNullString

End With

End Sub

Sub LeaveChat(ByVal index As Long)

Dim i as long

If ChatRoom(TempPlayer(index).roomIndex).Members - 1 = 0 Then

RemoveChat (TempPlayer(index).roomIndex)

Else

ChatRoom(TempPlayer(index).roomIndex).Members = _

ChatRoom(TempPlayer(index).roomIndex).Members - 1

End If

PlayerMsg index, "Left chatroom successfully.", Blue

for i = 1 to max_players

if i <> index then

if tempplayer(index).roomindex = tempplayer(index).roomIndex then

playermsg index, Player(index).name & " left the chatroom."

end if

end if

next

TempPlayer(index).roomIndex = 0

TempPlayer(index).inRoom = 0

End Sub
```

**modConstants:**

find

```

Public Const MAX_PARTY_MEMBERS As Long = 4

```
Below paste this

```

Public Const MAX_ROOMS As Long = 10

```

**modTypes:**

Find

```

Public Party(1 To MAX_PARTYS) As PartyRec

```
Below add

```

Public ChatRoom(1 To MAX_ROOMS) As ChatRoomRec

```
At the end of the module add

```

Private Type ChatRoomRec

index As Long

Name As String

Members As Long

End Type

```
Find

```

Public Type TempPlayerRec

```
Before 'End Type' add

```

' chat room

inRoom As Boolean

roomIndex As Long

```

**Thats all. If you have any problems with it please post below \/**

[Ertzel]

One question, whats the point of SChatMsg and Sub ChatRoomMsg. Why not just send a PlayerMsg to each player in the chat room with the message instead of sending it to a sub which then sends a packet to the client in it's own sub to print to the screen. PlayerMsg already does that so why make a whole other thing to do the same?

Also, in your server side source you have HandleChatMsg twice.

[abhi2011]

The orginal source uses it that way. So I thought why not go with it.

Thanks for the find.

[kibbelz]

I like it, good job. You made a typo in your title, it should be '[EO]' not '[E]'

[abhi2011]

E = Eclipse 

There's many eclipses EA, EO, ER, ED, DE. So a common name.

[Ganjika]

In modDatabase I get a (upon Compile) Sub or Function Not Defined with 'ChatRoom' highlighted in the "If Not ChatRoom(i).index = vbNull Then" line :

```

Sub CreateChat(ByVal Name As String, ByVal index As Long)

Dim i As Long

For i = 1 To MAX_ROOMS

If Not ChatRoom(i).index = vbNull Then

ChatRoom(i).index = i

ChatRoom(i).Name = Name

ChatRoom(i).Members = 1

TempPlayer(index).inRoom = True

TempPlayer(index).roomIndex = i

PlayerMsg index, "Your chat room '" & Name & "' has been created.", Blue

Exit For

End If

Next

End Sub

```

–---------------

[Ganjika](http://www.touchofdeathforums.com/community/index.php?/user/78057-ganjika/) [05:11 am] : in dragone clipse there is no Error Handler in the InitMessages() Sub, should i just place it at the end of the sub? [Abhi2011](http://www.touchofdeathforums.com/community/index.php?/user/70687-abhi2011/) [05:11 am] : yes

[abhi2011]

My mistake. Updating the topic. Server Side modTypes.

[Vus]

Nice and useful tutorial, great work.

[abhi2011]

Thanks.

[Ganjika]

Excellent Work!

[DarkOne5890]

Wait this works with the latest version of EA?

[kibbelz]

> E = Eclipse 
>
> There's many eclipses EA, EO, ER, ED, DE. So a common name.

You must always specify which engine, because some people still use 'out of date engines' aka ES *shakes head at the minority who do*. Since this code is compatible for any version of EO onwards put the engine as EO.

[abhi2011]

> Wait this works with the latest version of EA?

It will work on all engines EO 2.0+

> You must always specify which engine, because some people still use 'out of date engines' aka ES *shakes head at the minority who do*. Since this code is compatible for any version of EO onwards put the engine as EO.

Okay, editing topic.

[DarkOne5890]

Also everything here will not be done on the Developers Edition for EA correct?

[abhi2011]

Why would you make a chat room for Admins only? Wouldn't it be a system for all players 

Common sense.

[Ganjika]

for this to work on Dragon Eclipse 3.0 Nightly I had to change step 5 (i think it is step 5 at least) up:

The step for Dragon Eclipse users would be:

: thinki messed up my directions will repost shortly, there is one thing you need to do to make this work in dragon eclipse.

[Zopto]

dragon eclipse is 2.0

and nice

[abhi2011]

Pure DX8 engines might have different subs and function names for the same function. So there might be changes. But since CS:DE uses Eo 2.0 as a base I don't think there might be a difference and that this tutorial will work perfectly

[FinalLife]

This is quite a nice feature to have, :3 yet I see one flaw, how will a player know if someone left the chat-room ? Possible to add a notification?

[abhi2011]

I've added it in.

[iHero]

Great job! Maybe I'll add something like this in the Dream World 

[abhi2011]

> Great job! Maybe I'll add something like this in the Dream World 

Add one with a screen to see all the players in a chat. (I would love to do it. But I am a bit busy.)

[escfoe2]

Does this have a check list to make sure duplicate chat rooms aren't created. If you join chats based on the name, it would be hard to find the right one if you have more than one of the same. Obviously you understand. It doesn't seem like

This:

```

If Not ChatRoom(i).index = vbNull Then

```
Would cover it..

Otherwise, very good presentation and I give you a B+ overall performance. 

[abhi2011]

If you mean chat rooms with the same name then, yep you were right. It never checks chat rooms with similar names. I have added a loop that checks all the chat room names with the name given for the parameter.

[escfoe2]

> If you mean chat rooms with the same name then, yep you were right. It never checks chat rooms with similar names. I have added a loop that checks all the chat room names with the name given for the parameter.

Damn I good 

Glad I could help lol