Free Simple Database Driven Chat program by Adrian Forbes

Contributed by Adrian Forbes
Rating:

/ 26
January 01, 2003

Rate this Article:
MEH MEH++

SEARCH ASP FREE

I've noticed a few people request to do a chat app from ASP so I've knocked one up. I see you've already got a chat ASP script (from FailSafe),
Anyway, feel free to add this code straight to your site, it's not that feature rich but it demonstrates the kind of things you need to do.

It does not require a login but instead keeps a track of active users based on all the people who have posted within a certain timeframe. There are two options you can configure, how many minutes to keep active users and how many posts to be shown on screen. The main chat area shows you who posted what, at what time and what IP address they posted from, and it also shows a list of active users. It's nice and simple and includes the code to create the database and I've even commented the page that does all the work (although documentation is not my strong point!)

Menu.asp

<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
</HEAD>
<BODY>


<p>
<a href="createdb.asp">Create the database</a><br>
<a href="config.asp">Configure the parameters</a><br>
<a href="chat.asp">Chat</a><br>
</p>

</BODY>
</HTML>

CreateDB.ASP

<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
</HEAD>
<BODY>


<%
sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath ("/examples/test.mdb") & ";"
set objRS = CreateObject("ADODB.Recordset")
sSQL = "CREATE TABLE chat (ID int identity, strText memo not null, strUser varchar(50) not null" & _
sSQL = " strIP varchar(15) not null, dtDatePosted datetime not null)"
objRS.Open sSQL, sConnect

sSQL = "CREATE TABLE chatuser (strUser varchar(50) not null, dtLastPosted datetime not null)"
objRS.Open sSQL, sConnect

set objRS.ActiveConnection = nothing
set objRS = nothing

Application.Lock
Application("MaxMessages") = 10
Application("ActiveTime") = 5
Application.UnLock

%>

<p>Database created.</p>
<p><a href="menu.asp">Back to menu</a></p>
</BODY>
</HTML>

Config.asp

<%@ Language=VBScript %>
<%
sMax = trim(Request.Form("txtMax"))
sActive = trim(Request.Form("txtActive"))

if isnumeric(sMax) then
Application.Lock
Application("MaxMessages") = Clng(sMax)
Application.UnLock
end if

if isnumeric(sActive) then
Application.Lock
Application("ActiveTime") = Clng(sActive)
Application.UnLock
end if
%>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
</HEAD>
<BODY>


<p>
<form action="config.asp" method=post>
<table border=0>
<tr>
<td>Max number of messages</td><td><input type=text name=txtMax value="<%=Application("MaxMessages")%>"></td></tr>
<td>Time to keep users active (mins)</td><td><input type=text name=txtActive value="<%=Application("ActiveTime")%>"></td></tr>
</table>
<p><input type=submit value="Save"></p>
</form>
</p>
<p><a href="menu.asp">Back to menu</a></p>
</BODY>
</HTML>

Chat

<%@ Language=VBScript %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
</HEAD>
<BODY>


<p>
<form action="storechat.asp" method=post>
You Name:<input type=text name=txtName value="<%=Session("UserName")%>" maxlength=50><br>
<textarea name=txtChat cols=50 rows=3></textarea>
<br>
<input type=submit value="Chat">
</form>
</p>
<p>
Active users: <select size=1>
<%
' Select the list of users from the ChatUsers table
set objRS = CreateObject("ADODB.Recordset")
objRS.Open "SELECT strUser FROM chatuser ORDER BY strUser",
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath ("/examples/test.mdb") & ";"
while not objRS.EOF
Response.Write "<option>" & objRS("strUser") & vbCRLF
objRS.MoveNext
wend
objRS.Close
%>
</select>
</p>

<p>
<%
' Select each row form the Chat table
objRS.Open "SELECT strUser, dtDatePosted, strIP, strText FROM chat ORDER BY dtDatePosted DESC"
while not objRS.EOF
Response.Write "<p><b>" & objRS("strUser") & "</b> (at <b>" & FormatDateTime(objRS("dtDatePosted"), 3) & _
"</b> from IP <b>" & objRS("strIP") & "</b>) said<br>" & vbCRLF
Response.Write replace(server.HTMLEncode(objRS("strText")), vbCRLF, "<br>") & "</p>" & vbCRLF
objRS.MoveNext
wend
objRS.Close
set objRS.ActiveConnection = nothing
set objRS = nothing
%>
</p>
</BODY>
</HTML>

StoreChat.asp

<%@ Language=VBScript %>
<%
' Author: Adrian Forbes

' This script performs a number of tasks
' 1 Add text to the chat table in the database
' 2 Maintain the list of active users
' 2.1 Check if user is already active (i.e. do they exist in the ChatUsers table)
' 2.2 If they are not active (i.e. a new user) then insert their details into the table
' 2.3 If they are active update their record to show that they have just posted
' 3 Delete excess messages to ensure that only the configured amount are in the chat table

' Get the selected usermae
sUser = trim(Request.Form("txtName"))

' Store it in the session
Session ("UserName") = sUser

' Get the chat text
sText = trim(Request.Form("txtChat"))

' if either the username or chat text are blank then redirect back to chat page
if len(sUser) = 0 or len(sText) = 0 then
Response.Redirect "chat.asp"
end if

' set up the constants we are using
adCmdText = 1
adVarChar = 200
adDBTimeStamp = 135
adParamInput = 1

' Open our connection, this will be reused throughout

set objConnect = CreateObject("ADODB.Connection")
objConnect.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &_
Server.MapPath ("/examples/test.mdb") & ";"
objConnect.Open

' 1 First of all insert our chat text into the database

set objCommand = CreateObject("ADODB.Command")
with objCommand
set .ActiveConnection = objConnect
.CommandType = adCmdText
.CommandText = "insert into chat (strText, strUser, strIP, dtDatePosted) values (?, ?, ?, Now())"
.Parameters.Append .CreateParameter ("strText", adVarChar, adParamInput, len(sText), sText)
.Parameters.Append .CreateParameter ("strUser", adVarChar, adParamInput, 50, sUser)
.Parameters.Append .CreateParameter ("strIP", adVarChar, adParamInput, 15, Request.ServerVariables("REMOTE_ADDR"))
.Execute
end with
set objCommand.ActiveConnection = nothing
set objCommand = nothing

' 2.1 Now we have to find out if this user exists in the chatusers table, i.e. are they
' already active?

set objCommand = CreateObject("ADODB.Command")
with objCommand
set .ActiveConnection = objConnect
.CommandType = adCmdText
' This will return how many times they exist in the table. 0 means they are new
' 1 means they already exist. A user can't exist more than once in this table
.CommandText = "select count(*) from ChatUser where strUser = '" & sUser & "'"
set objRS = .Execute
if objRS(0) = 0 then
' 2.2 count is 0 so we have to add this user to the table
.CommandText = "insert into ChatUser (strUser, dtLastPosted) values (?, Now())"
else
' 2.3 count is not 0 so update this users entry to show that they have just posted
.CommandText = "update ChatUser set dtLastPosted = Now() where strUser = ?"
end if
.Parameters.Append .CreateParameter ("strUser", adVarChar, adParamInput, 50, sUser)
.Execute
end with
set objCommand.ActiveConnection = nothing
set objCommand = nothing

' Now we want to delete all users in the ChatUser table who have not posted within the
' configured time limit

set objCommand = CreateObject("ADODB.Command")
with objCommand
set .ActiveConnection = objConnect
.CommandType = adCmdText
' Use the DateDiff function to delete where the difference between now and when they last
' posted is > Application("ActiveTime") minutes
.CommandText = "delete from ChatUser where DateDiff (""n"", dtLastPosted, Now()) > " & Application("ActiveTime")
.Execute
end with
set objCommand.ActiveConnection = nothing
set objCommand = nothing

' 3 Now we want to delete the excess posts

set objRS = CreateObject("ADODB.Recordset")
' Get a list of all posts in descending order
objRS.Open "SELECT ID FROM chat ORDER BY dtDatePosted DESC", objConnect

lID = 0
i = 0
bExit = false
' Loop through each post
while not objRS.EOF and not bExit
i = i + 1
if i = Clng(Application("MaxMessages")) then
' The number of posts is bigger than the cofigured limit of Application("MaxMessages")
' Get the ID of this record as we want to delete all others
lID = objRS("ID")
bExit = true
end if
objRS.MoveNext
wend

objRS.Close

' Check if lID is > 0, if it is then there were more than the configured limit of
' messages
if lID > 0 then
' Delete all messages whose ID is less than this ID as they are too far down the list
objRS.Open "DELETE FROM chat WHERE ID < " & lID
end if
set objRS.ActiveConnection = nothing
set objRS = nothing

' Close our connection
objConnect.Close
set objConnect = nothing

Response.Redirect "chat.asp"
%>