<%
'
' --------------------- C H A T A P P L I C A T I O N S E T T I N G S
'
'
' Enable this state if you have changed the number of rooms in the chat
' or if you some users are 'hanging' in some rooms without getting auto-
' matically logged out. After having enabled this state go to the main
' page of the chat to refresh all data. Now change this state back to
' default in order to reenable the chat functionality.
'
' Default value: False
'
Const INITIALIZING_CHATSYSTEM = False
'
' Name of this Chat application. If you want to use it on your own site,
' you probably wants to give it a different name, e.g. 'Lucky Chat'. By
' changing this value, all text strings in chat will be changed.
'
' Default Value: ConquerChat On·Line
'
Const APPLICATION_NAME = "ConquerChat On·Line"
'
' Contains the e-mail address for the web administrator for this web site.
' If an error occurs or a user wants to send an email to the webmaster,
' this email will be shown.
'
' Default Value: webmaster@mydomain.com
'
Const WEBMASTER_EMAIL = "webmaster@mydomain.com"
'
' The maximum number of shown messages on the screen. You may want to
' limit this number in order to have all messages written on one page
' without the user having to scroll his/hers chat window. The value is
' on a 'per room' basis.
'
' Default Value: 25
'
Const MESSAGES = 25
'
' This specifies the number of users allowed to log into this chat. If
' you have a large site you may want to increase this number to allow
' more users.
'
' Default Value: 30
'
Const USERS = 30
'
' No more than X rooms are allowed to be created for any chat. This value
' will limit the number of rooms for the entire chat -- not just for one
' user.
'
' Default Value: 10
'
Const NUMBER_OF_ROOMS = 10
'
' Timeout in seconds - a session times out after 5 minutes (5*60=300) thus
' if a logged in user hasn't entered anything in the window he will be
' logged out in order to avoid taking up a space in the chat.
'
' Default Value: 300
'
Const TIMEOUT = 300
'
' Number of milliseconds a user needs to wait before sending a new
' message. This setting prevents "message flooding" so a user do not
' sends the same message a great number of times. Set this number to
' zero (0) if you want to disable it.
'
' Default Value: 1500
'
Const MESSAGE_FLOOD_TIMEOUT = 1500
'
' Specify is all messages should be wiped, when last user leaves the
' chatroom. This feature is also called the 'whiteboard cleaner'.
'
' Default Value: True
'
Const CLEAR_ON_EMPTY = True
'
' Clears message in textbox when it has been send off to the chat room.
' If this setting is False, the message will stay in the textbox, but
' will be highlighted to indicate you are able to just type in a new
' message to override the existing one.
'
' Default Value: True
'
Const CLEAR_MESSAGE = True
'
' If True, a typed smiley (e.g. :-) will be replaced by a small image
' representation.
'
' Default Value: True
'
Const USE_IMAGE_SMILEY = True
'
' List of default rooms available for all users. Rooms are separated
' using a simicolon (;) and first room is _always_ the default room,
' i.e. where all new users are placed
'
' Default Value: Entrance;Music;Sport
'
Const DEFAULT_ROOMS = "Entrance;Music;Sport"
'
' Indicates if all chat messages should print from top-to-bottom or from
' bottom-to-top. If this flag is set to True new messages will be
' printed in the top of the chat area otherwise a new message appear
' in the bottom.
'
' Default Value: True
'
Const NEWEST_MESSAGE_IN_TOP = True
'
' This value indicates the maximum length of a username. If a user enters
' a username larger than this value, he will be prompted to enter another
' name.
'
' Default Value: 20
'
Const MAX_USERNAME_LENGTH = 20
'
' Refresh rates for updating windows with messages, users and rooms. All
' rates are defined in seconds. Do not set these values too low since it
' may influence on the performance of your chat application.
'
' Default Value: 10
'
Const MESSAGES_REFRESH_RATE = 10
' Default Value: 15
Const USERS_REFRESH_RATE = 15
' Default Value: 15
Const ROOMS_REFRESH_RATE = 15
'
' Internal constant used for debugging this chat application. You should
' not need to enable it unless you are customizing ConquerChat and want
' to have a better detail level of used ids, etc.
'
' Default Value: False
'
Const DEBUG__ = False
'
' --------------------------------------------------------- C L A S S E S
'
Class Person
Private id_
Private name_
Private roomId_
Private lastAction_
Private loggedOn_
Private ipAddress_
Private sendMessages_
Private Sub Class_Initialize()
id_ = -1
name_ = "Guest"
roomId_ = -1
action()
loggedOn_ = Now()
ipAddress = ""
sendMessages_ = 0
End Sub
Public Property Get id
id = id_
End Property
Public Property Get name
name = name_
End Property
Public Property Get roomId
roomId = roomId_
End Property
Public Property Get lastAction
lastAction = lastAction_
End Property
Public Property Get loggedOn
loggedOn = loggedOn_
End Property
Public Property Get ipAddress
ipAddress = ipAddress_
End Property
Public Property Get sendMessages
sendMessages = sendMessages_
End Property
Public Property Let id(v)
id_ = v
End Property
Public Property Let name(v)
name_ = v
End Property
Public Property Let roomId(v)
roomId_ = v
End Property
Public Sub action()
lastAction_ = CStr(Now())
End Sub
Private Property Let loggedOn(v)
loggedOn_ = v
End Property
Public Property Let ipAddress(v)
ipAddress_ = v
End Property
Public Property Let sendMessages(v)
sendMessages_ = v
End Property
Public Property Get data
data = id_ & Chr(1) & name_ & Chr(1) & roomId_ & Chr(1) & lastAction_ & Chr(1) & loggedOn_ & Chr(1) & ipAddress_ & Chr(1) & sendMessages_
End Property
Public Property Let data(v)
Dim dataArray
dataArray = Split(v, Chr(1))
If (IsArray(dataArray) AND (UBound(dataArray) >= 6)) Then
' If (IsArray(dataArray)) Then
id_ = dataArray(0)
name_ = dataArray(1)
roomId_ = dataArray(2)
lastAction_ = dataArray(3)
loggedOn_ = dataArray(4)
ipAddress_ = dataArray(5)
sendMessages_ = dataArray(6)
End If
End Property
Private Sub debug()
Response.Write "| User |
| " & id_ & " | " & name_ & " | " & roomId_ & " | " & lastAction_ & " |
"
End Sub
End Class
Class Room
Private id_
Private name_
Private createdBy_
Private Sub Class_Initialize()
id_ = -1
name_ = "Guest"
createdBy_ = -1
End Sub
Public Property Get id
id = id_
End Property
Public Property Get name
name = name_
End Property
Public Property Get createdBy
createdBy = createdBy_
End Property
Public Property Let id(v)
id_ = v
End Property
Public Property Let name(v)
name_ = v
End Property
Public Property Let createdBy(v)
createdBy_ = v
End Property
Public Property Get data
data = id_ & Chr(1) & name_ & Chr(1) & createdBy_
End Property
Public Property Let data(v)
Dim dataArray
dataArray = Split(v, Chr(1))
If (IsArray(dataArray) AND (UBound(dataArray) >= 2)) Then
' If (IsArray(dataArray)) Then
id_ = dataArray(0)
name_ = dataArray(1)
createdBy_ = dataArray(2)
End If
End Property
Private Sub debug()
Response.Write "| Room |
| " & id_ & " | " & name_ & " | " & createdBy_ & " |
"
End Sub
End Class
' [>] moved to release 3.1
Class Message
Private roomId_ ' room where message appears
Private position_ ' line number for message (starting from 0)
Private userId_ ' user sending message
Private receiverId_ ' user receiving message (-1 for all)
Private text_ ' message
Public Property Get roomId
roomId = roomId_
End Property
Public Property Get position
position = position_
End Property
Public Property Get userId
userId = userId_
End Property
Public Property Get receiverId
receiverId = receiverId_
End Property
Public Property Get text
text = text_
End Property
Public Property Let roomId(v)
roomId_ = v
End Property
Public Property Let position(v)
position_ = v
End Property
Public Property Let userId(v)
userId_ = v
End Property
Public Property Let receiverId(v)
receiverId_ = v
End Property
Public Property Let text(v)
text_ = v
End Property
Public Property Get data
data = roomId_ & Chr(1) & position & Chr(1) & userId_ & Chr(1) & receiverId_ & Chr(1) & text_
End Property
Public Property Let data(v)
Dim dataArray
dataArray = Split(v, Chr(1))
If (IsArray(dataArray) AND (UBound(dataArray) >= 4)) Then
roomId_ = dataArray(0)
position_ = dataArray(1)
userId_ = dataArray(2)
receiverId_ = dataArray(3)
text_ = dataArray(4)
End If
End Property
Public Sub debug()
Response.Write("| Message |
| " & roomId_ & " | " & position_ & " | " & userId_ & " | " & receiverId_ & " | " & text_ & " |
")
End Sub
End Class
' Internal constants used within ConquerChat -- warning: please do not
' modify these values unless you know what you are doing!
Const USER_UNAVAILABLE = "-1"
Const PAGE_EXPIRED = "expired.asp"
'
' ------------------------------------- U T I L I T Y F U N C T I O N S
'
'
' The UserExists(username) function is able to find a specific logged in
' user using his or hers username (aka chatname).
'
' Function returns True if user was found, False otherwise.
'
Function UserExists(userName)
userName = Trim(userName)
Dim arUsers, i, user
arUsers = conquerChatUsers.Keys
For i = 0 To conquerChatUsers.Count-1
Set user = getUser(arUsers(i))
If (StrComp(userName, user.name, 1) = 0) Then
UserExists = True
Exit Function
End If
Next
UserExists = False
End Function ' // > Function UserExists(userName)
'
' Returns Room object specified by parameter "roomId". If the room
' does not exist, Nothing is returned
'
Function getRoom(roomId)
' make sure id is treated as a String variant
roomId = CStr(roomId)
If (conquerChatRooms.Exists(roomId)) Then
Set getRoom = New Room
getRoom.data = conquerChatRooms.Item(roomId)
Exit Function
End If
Set getRoom = Nothing
End Function ' // > Function getRoom(roomId)
Function getRoomByName(roomName)
Dim roomId
For Each roomId In conquerChatRooms
Set getRoomByName = getRoom(roomId)
If (NOT (getRoomByName Is Nothing)) Then
If (StrComp(roomName, getRoomByName.name, 1) = 0) Then
Exit Function
End If
End If
Next
Set getRoomByName = Nothing
End Function ' // > Function getRoomByName(roomName)
'
' The isLoggedIn(userId) function ensures a valid user login. If the user
' has been kicked out or his/hers session has expired, the user has been
' removed from the array of active users and thus needs to login again
' if he/she wants to continue chatting.
'
' Function returns True if user is logged in, False otherwise.
'
Function isLoggedIn(userId)
Dim user
Set user = getUser(userId)
If (NOT (user Is Nothing)) Then
Dim room
Set room = getRoom(user.roomId)
If (NOT (room Is Nothing)) Then
isLoggedIn = True
Exit Function
End If
End If
isLoggedIn = False
End Function ' // > Function isLoggedIn(userId)
'
' The "adduser(user)" function adds a new user to the chat. When a
' user enters, a unique key is generated in order to track user properly
' without using an ASP Session object.
'
' Function returns unique id of new user.
'
Function addUser(user)
' generate an unique id (timestamp) for this user session. To avoid
' having , or . in the id we replace them with 'x'
user.id = Replace(Replace(CStr(Timer), ",", "x"), ".", "x")
' as default, the user is placed in the main entrance room
user.roomId = 0
' add user to our internal structure of active users
conquerChatUsers.Add user.id, user.data
' return user with updated information
Set addUser = user
End Function ' // > Function addUser(user)
'
' Since classes in VBScript doesn't maintains its instance between pages
' we have to make sure all data we change on an instance will be stored
' in our global structure of users. This method simply reset the values
' for the specified user.
'
Private Function updateUser(user)
' reflect local changes in global object
conquerChatUsers.Item(user.id) = user.data
Set updateUser = user
End Function ' // > Private Function updateUser(user)
Sub logoutUser(userId)
userId = CStr(userId)
Dim user
Set user = getUser(userId)
Call addMessage( _
user.id, _
"-1", _
"
" & user.name & " decided to leave us at " & Now() & "
" _
)
' remove user timestamps and name
Call removeUser(userId)
Set user = Nothing
End Sub
'
' The 'removeUser(userId)' sub procedure removes a logged in user either
' because his/hers session has expired, was kicked or clicked on logout.
'
Private Sub removeUser(userId)
' make sure we convert this in-parameter to a string since we store
' user keys as strings in our global Dictionary object
userId = CStr(userId)
If (conquerChatUsers.Exists(userId)) Then
conquerChatUsers.Remove(userId)
' we need to remove all rooms for this user as well
removeUserRooms(userId)
End If
End Sub ' // > Private Sub removeUser(userId)
Private Function removeUserRooms(userId)
Application.Lock
Dim roomId, room
For Each roomId In conquerChatRooms
Set room = getRoom(roomId)
If (NOT room Is Nothing) Then
If (room.createdBy = userId) Then
removeRoom(room.id)
End If
End If
Next
' Dim roomIds, roomOwners, i
' roomIds = conquerChatRooms.Keys
' roomOwners = conquerChatRooms.Items
' If (IsArray(roomOwners)) Then
' For i = 0 To conquerChatRooms.Count-1
' If (roomOwners(i) = userId) Then
' conquerChatRooms.Remove(roomIds(i))
' End If
' Next
' End If
Application.UnLock
End Function ' // > Private Function removeUserRooms(userId)
'
' The countUsers function returns the number of currently logged in chat
' users in all rooms.
'
Function countUsers()
countUsers = conquerChatUsers.Count
End Function ' // > Function countUsers()
'
' Adds a new message to the room the user is currently located in. The
' message will be added to the queue of posted messages and printed for
' all users the next time the "window.asp" page is refreshed.
'
Function addUserMessage(userId, message)
' lock (synchronize) access to global variables
Application.Lock
' get user information
Dim user
Set user = getUser(userId)
' adds new message to queue
Call addMessage(userId, -1, message)
user.sendMessages = user.sendMessages + 1
' update users timestamp (thus we know he/she is active)
user.action()
' update internal class structure
updateUser(user)
' unlock access to global variables
Application.UnLock
End Function ' // > Function addUserMessage(userId, message)
Function addPrivateMessage(fromUserId, toUserId, message)
' get user information
Dim user
Set user = getUser(fromUserId)
' format message before adding it to message queue
message = Server.HTMLEncode(message)
message = Replace(message, "<b>", "", 1, -1, 1)
message = Replace(message, "</b>", "", 1, -1, 1)
message = Replace(message, "<i>", "", 1, -1, 1)
message = Replace(message, "</i>", "", 1, -1, 1)
message = Replace(message, "<u>", "", 1, -1, 1)
message = Replace(message, "</u>", "", 1, -1, 1)
message = "" & _
"" & _
" | " & user.name & " | " & _
" " & message & " | " & _
"
" & _
"
"
' adds new message to queue
Call addMessage(fromUserId, toUserId, message)
user.sendMessages = user.sendMessages + 1
' update users timestamp (thus we know he/she is active)
user.action()
' update internal class structure
updateUser(user)
End Function
'
' The getUser(userId) function returns the object of specified user.
' All users of this chat has a unique id in order to identify him/her
' without using sessions.
'
' Function returns object of user if found, 'Nothing' object otherwise.
'
Function getUser(userId)
userId = CStr(userId)
If (conquerChatUsers.Exists(userId)) Then
Set getUser = New Person
getUser.data = conquerChatUsers.Item(userId)
Exit Function
End If
Set getUser = Nothing
End Function ' // > Function getUser(userId)
Function getMessage(messageId)
messageId = CStr(messageId)
If (conquerChatMessages.Exists(messageId)) Then
Set getMessage = New Message
getMessage.data = conquerChatMessages.Item(messageId)
Exit Function
End If
Set getMessage = Nothing
End Function
Function addRoom(roomName, userId)
' check for valid room name
Dim check
Set check = New RegExp
check.Pattern = "[a-zA-z0-9 ]"
check.IgnoreCase = False
check.Global = True
If (NOT check.Test(roomName)) Then
addRoom = False
Exit Function
End If
Application.Lock
If (getRoomByName(roomName) Is Nothing) Then
Dim room
Set room = New Room
' room.id = Replace(Replace(CStr(Timer), ",", "x"), ".", "x")
room.id = CStr(conquerChatRooms.Count)
room.name = roomName
room.createdBy = userId
conquerChatRooms.Add room.id, room.data
addRoom = True
Else
addRoom = False
End If
Application.UnLock
End Function ' // > Function addRoom(roomName, userId)
Function removeRoom(roomId)
' treat as string
roomId = CStr(roomId)
' make sure we actually have the room we are about to remove
If (conquerChatRooms.Exists(roomId)) Then
' remove from global internal structure
conquerChatRooms.Remove(roomId)
' transfer all users from this (removed) room to main entrance
Dim userId, user
For Each userId In conquerChatUsers
Set user = getUser(userId)
If (NOT user Is Nothing) Then
If (user.roomId = roomId) Then
user.roomId = 0
updateUser(user)
End If
End If
Next
End If
End Function ' // > Function removeRoom(roomId)
' this user wants to switch to another room thus we have to remove
' the id from the old one and place it in the new
Function enterRoom(userId, roomId)
Application.Lock
Dim user
Set user = getUser(userId)
' notify users in old room
Call addUserMessage(userId, " " & user.name & " left the room
")
' change room
user.roomId = roomId
updateUser(user)
' notify users in new room
Call addUserMessage(userId, " " & user.name & " has entered the room
")
Application.UnLock
End Function ' // > Function enterRoom(userId, roomId)
Function getNumberOfPublicMessages()
Dim i, message
getNumberOfPublicMessages = 0
For i = 0 To conquerChatMessages.Count-1
Set message = getMessage(CStr(i))
If (StrComp(CStr(message.receiverId), "-1", 1) = 0) Then
getNumberOfPublicMessages = getNumberOfPublicMessages + 1
End If
Next
End Function ' // > Function getNumberOfPublicMessages()
Sub pushMessage(data)
If (getNumberOfPublicMessages() >= MESSAGES) Then
' we need to remove a public entry from message array
Dim i
For i = 0 to conquerChatMessages.Count-2
conquerChatMessages.Item(CStr(i)) = conquerChatMessages.Item(CStr(i+1))
Next
conquerChatMessages.Remove(CStr(conquerChatMessages.Count-1))
End If
conquerChatMessages.Add CStr(conquerChatMessages.Count), data
End Sub
Function addMessage(userId, receiverId, text)
Dim user, message
Set user = getUser(CStr(userId))
Set message = New Message
message.roomId = user.roomId
message.userId = user.id
message.receiverId = receiverId
message.text = text
pushMessage(message.data)
Set addMessage = message
End Function ' // > Function addMessage(userId, receiverId, text)
Sub printMessages(roomId, userId, topToBottomOrder)
Dim a, b, c, i, message
If (topToBottomOrder) Then
a = conquerChatMessages.Count-1
b = 0
c = -1
Else
a = 0
b = conquerChatMessages.Count-1
c = 1
End If
For i = a To b Step c
Set message = getMessage(i)
If (message.roomId = roomId) Then
If (StrComp(CStr(message.receiverId), "-1", 1) = 0) Then
' messages to all users
Response.Write(message.text)
ElseIf (StrComp(CStr(message.receiverId), CStr(userId), 1) = 0) Then
' private messages to this user
Response.Write(message.text)
End If
End If
Set message = Nothing
Next
' For i = 1 To MESSAGES
' Response.Write Application("$CONQUERCHAT:MESSAGES_" & user.roomId & "_" & i)
' Next
End Sub
'
' We do not want to have inactive users in our chat. In order to avoid
' this, we enumerate all users last chat line and check the timestamp
' on it. If it is older than the allowed inactivity limit, the user
' is kicked from the chatroom
'
Function kickInactiveUsers()
Dim i, now_
now_ = Now()
Application.Lock
Dim userId, user
For Each userId In conquerChatUsers
Set user = getUser(userId)
If (NOT user Is Nothing) Then
' If (user.lastAction = "") Then
' ' somehow the lastAction is able to get zero or empty. I
' ' do not know why, but we take care of it by pinging the
' ' user (setting the lastAction) and .. well -- we're ex-
' ' tending his life a bit.
' user.action()
' Call updateUser(user)
' End If
If (DateDiff("s", CDate(user.lastAction), now_) > TIMEOUT) Then
' this user needs to be logged out - he fell asleep in class..hmm
Call removeUser(userId)
For i = MESSAGES To 2 Step - 1
Application("chatline_" & i) = Application("chatline_" & i-1)
Next
Application("chatline_1") = " " & user.name & " fell asleep and was put to bed at " & now_ & "
"
End If
End If
Next
Application.UnLock
End Function ' // > Function kickInactiveUsers()
%>