Теперь нам нужно разработать страничку, содержащую все пользовательские сообщения. Она, по сути, должна отображать содержимое соответствующей таблицы нашей базы данных (таблицы Chat). Страничка должна самообновляться каждые Session("RefreshTime") секунд:
<!--#include file="utils.asp"-->
<html>
<%
Response. Write "<META http-equiv='refresh' content='" & CInt(Session("RefreshTime")) & "'>"
%>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
</head>
<body bgcolor="#D7D5C0" text="#000000" link="#000000" vlink="#FFFFFF" alink="#FFFFFF">
<%
Dim MaxLines, Str
MaxLines = CInt(Session("LNum"))
Call Connect
sSQL = "SELECT TOP " & CStr (MaxLines) & " * FROM Chat Order By DateSaid DESC"
Rs.open sSQL, Conn
Do While Not Rs.Eof
Str = Rs.Fields("Said").value
Response.Write Str
Rs.MoveNext
Loop
Response.Write "<br>"
Call Close
%>
</body>
</html>
|
|
Теперь нам потребуется страничка посылки сообщений в чат. Для этого понадобится HTML-форма с текстовым полем ввода сообщения, парой кнопок и «радиопереключателем» смайликов к сообщениям. Последние лежат в каталоге Images к исходникам настоящей статьи. После нажатия пользователем на кнопку «Сказать» необходимое сообщение, обрамленное соответствующими тэгами (цвет, смайлик) попадет в базу данных.
<!--#include file="utils.asp"-->
<SCRIPT LANGUAGE = VBScript RUNAT=Server>
<!-- Metadata type="typelib" File="c:\program files\common files\system\ado\msado15.dll" -->
</SCRIPT>
<%
Dim TextStr, ImageFileName
Session.TimeOut = 1
If Session("UserName") <> "" Then
Response.Write "Пользователь: " & Session("UserName") & "<br>"
Else
Response.Write "Вы покинули чат. <br>"
End If
If Request("go") = "Войти" Then
Response.Redirect("Entrance.asp")
End If
If Request("exit") = "Выйти" Then
TextStr = "<table><tr><td><b><font color='" & Session("UserColor") &_
"'>" & Session("UserName") & "</font></B> : " &_
"покинул чат - " & date & " " & time & "</td></tr></table>"
Call Connect()
sSQL = "SELECT * FROM Chat"
RS.Open sSQL, Conn, 3, adLockOptimistic
rs.AddNew
rs("UserID") = 0
rs("DateSaid") = Now()
rs("Said") = TextStr
rs.Update
Call Close()
Call Connect()
sSQL = "UPDATE ChatUsers Set IsOnLine = 0 WHERE UserID = " & Session("UserID")
Conn.Execute(sSQL)
Conn.close
set Conn = nothing
Session("UserName") = ""
Session("UserID") = 0
End If
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
</head>
<script>
function ReEnter()
{
window.navigate("Entrance.asp");
}
</script>
<body bgcolor="#D7D5C0" text="#000000" link="#000000" vlink="#FFFFFF" alink="#FFFFFF">
<%
TextStr = Trim (Request.Form("txtbox"))
If InStr(TextStr, "<") < 1 Then
If TextStr <> "" Then
Select Case CInt(Request.Form("MsgIcon"))
Case 0 'Smile
ImageFileName = ""
Case 7 'Smile
ImageFileName = "Images\icon7.gif"
Case 2 'Smile
ImageFileName = "Images\icon2.gif"
Case 3 'Smile
ImageFileName = "Images\icon3.gif"
Case 4 'Smile
ImageFileName = "Images\icon4.gif"
Case 5 'Smile
ImageFileName = "Images\icon5.gif"
Case 6 'Smile
ImageFileName = "Images\icon6.gif"
Case 8 'Smile
ImageFileName = "Images\icon8.gif"
Case 9 'Smile
ImageFileName = "Images\icon9.gif"
Case 10 'Smile
ImageFileName = "Images\icon10.gif"
Case 11 'Smile
ImageFileName = "Images\icon11.gif"
Case 12 'Smile
ImageFileName = "Images\icon12.gif"
Case 13 'Smile
ImageFileName = "Images\icon13.gif"
Case 14 'Smile
ImageFileName = "Images\icon14.gif"
End Select
TextStr = Replace(TextStr, vbCrLf, "<br>")
If (ImageFileName <> "") Then
TextStr = "<table><tr><td width=15 valign='top'><img src = '" & _
ImageFileName & "'></td>" &_
"<td width=70 valign='top'><B><font color = '" & Session("UserColor") &_
"'>" & Session("UserName") & "</td><td>" &_
"</font></B>" & " : " & TextStr & "</td></tr></table>"
Else
TextStr = "<table><tr><td width=15 valign='top'></td>" &_
"<td width=70 valign='top'><B><font color = '" & Session("UserColor") &_
"'>" & Session("UserName") & "</td><td>" &_
"</font></B>" & " : " & TextStr & "</td></tr></table>"
End If
Call Connect()
sSQL = "SELECT * FROM Chat"
RS.Open sSQL, Conn, 3, adLockOptimistic
rs.AddNew
rs("UserID") = Session("UserID")
rs("DateSaid") = Now()
rs("Said") = TextStr
rs.Update
Call Close()
Application("IsRefresh") = True
End If
End If
%>
<FORM name= "ChatForm" method="post" action="chat.asp">
<table>
<tr>
<td valign="top" align="right">
<INPUT type="radio" name="MsgIcon" value="0" CHECKED>нет
<INPUT type="radio" name="MsgIcon" value="10"><IMG SRC="Images/icon10.gif" alt="улыбка" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="11"><IMG SRC="Images/icon11.gif" alt="возмущение" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="12"><IMG SRC="Images/icon12.gif" alt="подмигивание" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="13"><IMG SRC="Images/icon13.gif" alt="плохо" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="14"><IMG SRC="Images/icon14.gif" alt="хорошо" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="2" ><IMG SRC="Images/icon2.gif" alt="поговорим" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<BR>
<INPUT type="radio" name="MsgIcon" value="3" ><IMG SRC="Images/icon3.gif" alt="лампочка" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="4" ><IMG SRC="Images/icon4.gif" alt="внимание" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="5" ><IMG SRC="Images/icon5.gif" alt="вопрос" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="6" ><IMG SRC="Images/icon6.gif" alt="радость" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="7" ><IMG SRC="Images/icon7.gif" alt="одобрение" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="8" ><IMG SRC="Images/icon8.gif" alt="раздражение" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<INPUT type="radio" name="MsgIcon" value="9" ><IMG SRC="Images/icon9.gif" alt="грусть" HEIGHT=15 WIDTH=15 ALIGN=ABSCENTER>
<BR>
</td>
<td>
<textarea cols="56" rows="5" style="font: 8pt 'Verdana'; background-color: #FCFBE8;" value="" name="txtbox"></textarea>
</td>
<td valign="top">
<table><tr><td>
<% If Session("UserName") <> "" Then %>
<Input type = Submit Style="font: 8pt 'Verdana'; Width: 65" value="Сказать" name="go">
</td></tr>
<tr><td>
<Input type = Submit Style="font: 8pt 'Verdana'; Width: 65" value="Шепнуть" name="whisper">
</td></tr>
<tr><td>
<Input type = Submit Style="font: 8pt 'Verdana'; Width: 65" value="Выйти" name="exit">
</form>
<% Else %>
</form>
<form method="post" action="chat.asp" target="_top">
<Input type = Submit Style="font: 8pt 'Verdana'; Width: 55" value="Войти" name="go" Onclick="ReEnter()";>
</form>
<% End If %>
</td></tr></table>
</td> </tr> </table>
</body>
</html>
Как видите, все довольно просто; в результате у нас получился инструмент ввода сообщений в чат. Нам осталось только разработать страничку, аналогичную Text.asp, но показывающую не текстовые сообщения, а список псевдонимов (кто в чате), и упорядочить все страницы проекта с помощью фреймов.
|
|
Все делается аналогично страничке Text.asp: самообновление страницы, показ списка пользователей. Здесь нет ничего сложного, и нам необходимо просто извлечь из таблицы пользователей список имен-псевдонимов тех, кто в чате, и показать его:
<!--#include file="utils.asp"-->
<html>
<%
Response. Write "<META http-equiv='refresh' content='" & CInt(Session("RefreshTime")) & "'>"
%>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
</head>
<body bgcolor="#D7D5C0" text="#000000" link="#000000" vlink="#FFFFFF" alink="#FFFFFF">
<p><b>Сейчас в чате:</b></p>
<%
Dim CurUser, Odd, Str, Who, Umail
CurUser = 0
Odd = 0
Call Connect
sSQL = "SELECT * FROM ChatUsers WHERE IsOnline = 1"
Response.Write "<table>"
Rs.open sSQL, Conn
Do While Not rs.EOF
If Odd = 0 Then
If Rs.Fields("UserNickName").value <> "" Then
Who = Rs.Fields("UserName").value
UMail = Rs.Fields("UserMail").value
Str = "<tr><td><font color=" & Session("UserColor") & ">["
Str = Str & "<A HREF='mailto:" & UMail & "'>"
Str = Str & "<font color=" & Session("UserColor") & ">" & Rs.Fields("UserNickName").value & "</font>"
Str = Str & "</a>]</font></td></tr>"
Response.Write Str
Odd = 1
CurUser = CurUser + 1
End If
Else
Odd = 0
Rs.MoveNext
End If
Loop
Response.Write "</table>"
If CurUser = 0 Then
Response.Write "<p>нет пользователей</p>"
Else
Response.Write "<p>Всего " & CurUser & "</p>"
End If
Call Close
%>
</body>
</html>
|
|
Теперь нам надлежит оформить одну страницу из трех (Chat.asp, Nicks.asp и Text.asp) с помощью фреймов. Для начала создадим вертикальный фрейм:
<%@ LANGUAGE = VBScript%>
<%
If Session("UserName") = "" Then
Response.Redirect("Entrance.asp")
End If
%>
<HTML>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
<TITLE> Чат</TITLE>
</head>
<Frameset frameborder="NO" border="0" framespacing="0" rows="80%, 19%, 1%">
<frame name="textFrame" src="RightFS.asp">
<frame name="chatFrame" src="chat.asp">
<frame name="FalseFrame" src="FF.asp">
</Frameset>
</HTML>
затем представим горизонтальный фрейм следующим образом:
<html> <head> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> </head> <frameset cols="85%,15%" frameborder="YES" border="1" framespacing="0"> <frame name="mainFrame" src="text.asp"> <frame name="rightFrame" src="Nicks.asp"> </frameset> <noframes> <body bgcolor="#FFFFFF" text="#000000"> </body> </noframes> </html>
|
|
Если помните, в предыдущей версии чата (в его файл-основанной версии) задача перевода пользователя в режим офлайн не была решена. Точнее, была предпринята попытка ее решения с использованием соответствующей функции файла global.asa. Теперь мы будем делать это гарантированно, ведь пользователь может покинуть чат, не нажав кнпоку выхода (в этом случае система получает сигнал о том, что необходимо выставить соответствующее значение флажка режима пользователя). В случае же непредсказуемого выхода (переход по другому адресу или закрытие окна браузера) таким сигналом может служить лишь сообщение, получаемое при наступлении соответствующего события непосредственно в браузере. Для этой цели в тэг <body> html-документа можно вставить следующий код:
<body onunload="open('term.asp');self.close()">
который, как вы видите, во-первых, инициализует выполнение функций выхода в модуле “term.asp”, а во-вторых — приводит к закрытию окна, породившего само событие (директива self.close()).
Однако в нашем случае ситуация несколько усложняется наличием фреймов. Поэтому, как вы, наверное, заметили, при оформлении набора фреймов умышленно был создан скрытый фрейм «FalseFrame», который специально предназначен для решения этой проблемы и исходный текст модуля которого выглядит следующим образом:
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
</head>
<script Language="JavaScript">
var timerID = null;
var timerRunning = false;
function stopclock () {
if (timerRunning)
clearTimeout(timerID);
timerRunning = false;
}
function showtime () {
var now = new Date();
var hours = now.getHours();
var minutes = now.getMinutes();
var seconds = now.getSeconds()
var timeValue = "" + ((hours >12) ? hours -12 :hours)
timeValue += ((minutes < 10) ? ":0" : ":") + minutes
timeValue += ((seconds < 10) ? ":0" : ":") + seconds
timeValue += (hours >= 12) ? " дня" : " утра"
window.status = "Время на сервере: " + timeValue;
timerID = setTimeout("showtime()",1000);
timerRunning = true;
}
function startclock () {
stopclock();
showtime();
}
</script>
<body onLoad="startclock()" onunload="open('term.asp');self.close()" bgcolor="#D7D5C0" text="#000000" link="#000000" vlink="#FFFFFF" alink="#FFFFFF">
</body>
</html>
Как видите, модуль, помимо последних строк, решающих проблему «самозакрытия» и переадресации функции завершения сеанса работы определенного пользователя, содержит еще и код, отображающий серверное время в статусной строке (строке состояния) окна браузера.
Завершение сеанса работы при выходе пользователя (файл term.asp)
Теперь нам осталось разобраться с действиями, которые должен выполнять пользователь, покидая чат-систему, если он не воспользовался кнопкой выхода:
<!--#include file="utils.asp"-->
<SCRIPT LANGUAGE = VBScript RUNAT=Server>
<!-- Metadata type="typelib" File="c:\program files\common files\system\ado\msado15.dll" -->
</SCRIPT>
<html>
<body onLoad = "self.close()">
<%
Dim TextStr
TextStr = "<table><tr><td><b><font color='" & Session("UserColor") &_
"'>" & Session("UserName") & "</font></B> : " &_
"вышел из чата - " & date & " " & time & "</td></tr></table>"
Call Connect()
sSQL = "SELECT * FROM Chat"
RS.Open sSQL, Conn, 3, adLockOptimistic
rs.AddNew
rs("UserID") = 0
rs("DateSaid") = Now()
rs("Said") = TextStr
rs.Update
Call Close()
Call Connect()
sSQL = "UPDATE ChatUsers Set IsOnLine = 0 WHERE UserID = " & _
Session("UserID")
Conn.Execute(sSQL)
Conn.close
set Conn = nothing
%>
</body>
</html>
|
|
В заключение хотелось бы остановиться на сильных и слабых сторонах рассмотренной нами чат-системы. Прежде всего очевидное достоинство базо-основанной системы заключается в производительности по сравнению с файл-основанным аналогом. Данный пример, хоть и намеренно создан с целью обучения, тем не менее вполне может служить «двигателем» для реального, активно посещаемого чата. Недостаток здесь, пожалуй, кроется в некотором усложнении программного подхода, увеличении числа выполняемых действий, усложнении структуры Web-приложения, тем не менее, как вы видите теперь, задача довольно проста и все эти сложности скорее кажущиеся, чем реальные.
С автором статьи можно связаться по следующему адресу: rouben@iname.com
КомпьютерПресс 8'2001
