<% ASP на блюдечке %>. Часть 12
Просмотр списка сообщений чата (файл Text.asp)
Теперь нам нужно разработать страничку, содержащую все пользовательские сообщения. Она, по сути, должна отображать содержимое соответствующей таблицы нашей базы данных (таблицы 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>
 |
|
Посылка сообщения в чат (файл Chat.asp)
Теперь нам потребуется страничка посылки сообщений в чат. Для этого понадобится 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, но показывающую не текстовые сообщения, а список псевдонимов (кто в чате), и упорядочить все страницы проекта с помощью фреймов.
|
|
Показ псевдонимов (кто в чате) — файл Nicks.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
