您所在位置：主题：一个完整的，简单的聊天室程序！~~~~
Kilven2003
[专家分：60] 发布于 2004-04-16 15:04:00
完整的聊天室原代码(login_chat.htm ，default.htm ，global.asa， chat.asp)
login_chat.htm
<html>
<head>
<title>登记进入聊天室</title>
<script language=vbscript>
function ao()
li.name.value=Trim(li.name.value)
if li.name.value="" then li.name.value="匿名来客"
li.submit
end function
function ch(whichobj)
whichobj.checked=true
end function
</script>
</head>
<body background="backchat.jpg" bgcolor="#FFFFFF">
<table height=100%>
<tr>
<td valign=center>
<center>
<font color="#FF0000" size="5" face="隶书">聊 天 室</font>
<form name='li' action="uif.asp" method="POST" align=center>
请输入您的姓名：
<input type="text" size="18" name="name" style="font-size: 12pt">
<input type="button" name="B1" onClick='ao()' value="进入" style="
font-size: 12pt">
</form>
<font color="#0000ff" size="5" face="隶书">注意事项</font></center>
<ol>
<li><font size="3">请将本窗口<strong>最大化</strong>，这样可得到最
佳的视觉效果。</font></li>
<li><font size="3">在聊天过程中，请注意<strong>语言使用</strong>，
<strong>尊重对方</strong>。请不要使用不适合学生使用的语言。</font></li
>
</ol>
</td></tr>
<tr><td valign=buttom align=center>
<a href="mailto:whitek@netease.com">本聊天室有 小宝 制作,欢迎您提出宝贵
建议</a>
</td></tr>
</table>
</body>
</html>
-----------
default.htm
<html>
<head>
<title>聊天室</title>
</head>
<frameset cols="*,150">
<frameset rows="*,0">
<frame name=uif src="login_chat.htm" noresize>
<frame name=sendwords border=0 src="about:blank" noresize>
</frameset>
<frame name=refresh src="userlist.asp" noresize>
</frameset>
</html>
------------------
global.asa
<script language=vbscript runat=server>
SUB Application_OnStart
Application.lock
'Global variables
application("filepath")="D:\网页的研究\chat\"
application("userlist")=""
application("userhtml")=""
application("usercount")=0
'Connections
set con=createobject("adodb.connection")
con.open "wwwchat.dbf"
set application("wwwchat")=con
set con=nothing
'For actions
dim action(1,200),actionsize,actioncount,actionselect
actionselect=""
actionsize=200
actioncount=0
con=application("wwwchat")
set rec=createobject("ADODB.recordset")
rec.open "select * from "&application("filepath")&"chataction.dbf",co
n
do until rec.EOF
if actioncount>=actionsize then
exit do
end if
actionname=trim(rec("action"))
actionmeaning=trim(rec("meaning"))
actionselect=actionselect&"<option value="&chr(34)&actionname&chr(3
4)&">"&replace(actionmeaning,"#","(对象)")&"</option>"
actioncount=actioncount+1
action(0,actioncount)=actionname
action(1,actioncount)=actionmeaning
rec.MoveNext
loop
rec.close
set rec=nothing
set con=nothing
application("action")=action
application("actioncount")=actioncount
application("actionselect")=actionselect
Application.unlock
END SUB
SUB Application_OnEnd
Application.lock
set application("alinks")=nothing
set application("linktoaa")=nothing
Application.unlock
END SUB
</script>
----------------
chat.asp
<% @ language="vbscript" %>
<html>
<head>
<title>聊天室</title>
<script language=javascript>
function kp() {
if (event.keyCode==13) e(0);
}
function ref() {
if (event.shiftKey==1 && event.ctrlKey==1 && event.altKey==1) {
see.location="http://118.118.118.45/vclass/seeinfo.asp?lastcount=0&
ip=1";}
else {
see.location="http://118.118.118.45/vclass/seeinfo.asp?lastcount=0"
;
}
}
</script>
<script language=vbscript>
function e(way)
if way=3 then
talk.document.location="about:blank"
talk.document.location="about:blank"
call ref
exit function
end if
if way=1 then
cc.obj.value=""
cc.words.value="我走了......"
end if
n1=replace(replace(replace(replace(cc.obj.value,"%","%25"),"#","%23"),
"&","%26"),"?","%3F")
n2=replace(replace(replace(replace(cc.words.value,"%","%25"),"#","%23"
),"&","%26"),"?","%3F")
cc.words.value=""
a="http://118.118.118.45/vclass/send.asp?obj="&n1&"&words="&n2&"&name=
"&replace(replace(replace(replace(cc.name.value,"%","%25"),"#","%23"),
"&","%26"),"?","%3F")
parent.sendwords.location=a
end function
</script>
</head>
<body background="backchat.jpg" leftmargin=0>
<table width=100% height=100% style="font-size:<%=request.form("fs")%>
">
<tr>
<td height=20 align="center"><font color="#FF0000"><% =request.form("n
ame")%> 欢迎您光临 <a href="http://118.118.118.45/vclass/default.htm"
target=_blank onMouseOver='status="前往 高一(1)班"' onMouseOut='statu
s=""'>高一(1)班</a> 聊天室</font></td>
</tr>
<tr>
<td height="*">
<iframe name="talk" src="about:blank" width=100% height=100%>
</iframe>
</td>
<tr>
<td height=20 valign=bottom>
<form name='cc'>
<input type='hidden' name="name" value='<% =request.form("name") %
>' >
<p align=center>说话对象：<input type="text" size="5" style="font-
size:<%=request.form("fs")%>" name="obj" value=<% =request.form("obj")
%>>
请说话：<input type="text" size="32" style="font-size: <%=request.form
("fs")%>" name="words" onKeyPress='kp();'>
<input type="button" onclick="e(0)" name="B1" style="font-size: <%
=request.form("fs")%>" value="发送" default>
<input type="button" name="B2" onclick="e(1)" value="离开" style="
font-size: <%=request.form("fs")%>">
<input type="button" name="B2" onclick="e(3)" value="刷新" style="
font-size: <%=request.form("fs")%>">
<a href="action.htm" target="_blank" onMouseOver='status="特殊语言
使用说明"' onMouseOut='status=""'>特殊语言</a>
</p>
</form>
</td>
</tr>
</table>
<script language="vbscript">
b="http://118.118.118.45/vclass/seeinfo.asp?lastcount=0"
parent.refresh.location=b
cc.words.focus
</script>
</body>
</html>
-----------------
chatmg.asp
<%@language=vbscript%>
<%
if request.querystring("pw")="g11chat" then
if request.querystring("action")="clear" then
application.lock
application("userlist")=""
application("userhtml")=""
application("usercount")=0
application.unlock
response.write "OK!"
end if
end if
%>
-------------
seeinfo.asp
<% @ language="vbscript" %>
<% Response.Expires=0 %>
<html>
<head>
<script language="javascript">
function mclick(st) {
if (event.altKey==1 &&
parent.uif.document.cc.obj.value!="") {
parent.uif.document.cc.obj.value=st+"、"+parent.uif.document.cc.
obj.value;
return 0;
}
parent.uif.document.cc.obj.value=st;
}
function c(ct) {
location="seeinfo.asp?lastcount="+ct;
}
</script>
<script language=vbscript>
function mover(ob)
ob.style.background="blue"
ob.style.color="red"
end function
function mout(ob)
ob.style.background=""
ob.style.color=""
end function
function mclic1k(st)
parent.uif.document.cc.obj.value=st
end function
</script>
</head>
<body bgcolor="#ffffff" onError="">
<%
'Get paraments
dim lastcount,ipable
lastcount=request.querystring("lastcount")+0
ipable=request.querystring("ip")+0
response.write "<!--"&lastcount&"-->"
'Creat connection
set con=application("wwwchat")
set rec=createobject("adodb.recordset")
if lastcount=0 then
if ipable<>1 then
rec.open "select * from "&application("filepath")&"wwwchat where va
l(id)>recc()-10",con
else
rec.open "select * from "&application("filepath")&"wwwchat where va
l(id)>recc()-200",con
end if
else
rec.open "select * from "&application("filepath")&"wwwchat where va
l(id)>"&lastcount,con
end if
'Seek records
dim j,lastid,thisid
j=""
response.write "<script language=vbscript>"
%>
parent.uif.talk.document.write "<font face=宋体>"
<%
do until rec.EOF
infoname=rtrim(rec("name").value)
infowords=rtrim(rec("info").value)
if ipable=1 then response.write "parent.uif.talk.document.write "&c
hr(34)&rtrim(rec("ip"))&chr(34)&chr(13)
mess="<font color=blue>"&infoname&"</font>"&infowords&"
"
%>
parent.uif.talk.document.write "<% =replace(mess,chr(34),""")
%>"
<%
j=rec("id")
rec.movenext
loop
rec.close
set con=nothing
response.write "</script>"
response.write "<!--"&j&"-->"
if j<>"" then %>
<script language=javascript>
parent.uif.talk.scroll(0,65000);
parent.uif.talk.scroll(0,65000);
parent.uif.talk.document.write("</font>");
</script>
<%
else
j=lastcount
end if
%>
<script language=javascript>
setTimeout("c(<% =trim(j) %>);",3000);
</script>
<center>用户列表</center>
<hr>
<table width=100% align=center style="cursor:hand">
<tr><td onMouseover='mover(this)' onMouseOut='mout(this)' onClick='mcl
ick("所有人")'>
(所有人)
</td></tr>
<%
=application("userhtml")
%>
</table>
<hr>
<center>共<font color=red><%=application("usercount")%></font>人
<b
r><font color=blue>按住Alt可复选</font></center>
</body>
</html>
----------
send.asp
<% @ language="vbscript"%>
<%response.expires=0%>
<%
function relist
dim nl,nlen,startp,c,nh
response.write "inlist:"&application("userlist")&"
"
nl=application("userlist")
nlen=len(nl)
startp=1
c=0
nh=""
do while startp<nlen
le=instr(startp,nl,"<")
ri=instr(startp,nl,">")
if le>0 and le<nlen and ri>le and ri<=nlen then
ss=replace(mid(nl,le+1,ri-le-1),chr(34),""")
nh=nh&"<tr><td onMouseover='mover(this)' onMouseOut='mout(this)'
onClick='mclick("&chr(34) & replace(ss,chr(34),"(引号)") & chr(34)&")
'>"
nh=nh&ss&"</td></tr>"&chr(13)&chr(10)
'response.write "one!"&nh&"
" chr(34)&"&chr(34)&"&chr(34)
c=c+1
else
exit do
end if
startp=ri+1
loop
application.lock
application("userhtml")=nh
application("usercount")=c
'response.write nh&"aa"
end function
%>
<html>
<%
'Send message
dim obj,name,words,iname
obj=trim(request.querystring("obj"))
if obj="" then obj="所有人"
name=replace(replace(replace(trim(request.querystring("name")),";","；
"),"[","［"),"]","］")
words=replace(replace(replace(trim(request.querystring("words")),";","
；"),"[","［"),"]","］")
byebye=trim(request.querystring("go"))&""
joinin=trim(request.querystring("joinin"))&""
iname=replace(replace(name,"<","<"),">",">")
if joinin="1" and instr(application("userlist"),"<"&iname&">")>0 then
response.end
end if
if byebye="1" then
application.lock
application("userlist")=replace(application("userlist"),"<"&iname&"
>","")
application.unlock
call relist
else
if instr(application("userlist"),"<"&iname&">")<=0 then
application.lock
application("userlist")=application("userlist")&"<"&iname&">"
application.unlock
call relist
end if
end if
set con=application("wwwchat")
set com=createobject("adodb.command")
com.activeconnection=con
response.write "send this time"
dim n1,n2,sd,ad
n1=name
n2=obj
n2="对<font color=blue>"&n2&"</font>说："&words
action=application("action")
actioncount=application("actioncount")
for ai=1 to actioncount
if action(0,ai)=words then
words="<font color=red>"&action(1,ai)&"</font>"
for i=1 to len(words)
c=right(left(words,i),1)
if c="#" then
words=left(words,i-1)&"<font color=blue>"&obj&"</font>"&righ
t(words,len(words)-i)
exit for
end if
next
n2=":"&words
end if
next
com.commandtext="INSERT INTO wwwchat (name,info,ip,id) VALUES (?,?,?,a
llt(str(recc()+1)))"
com.Parameters.Append com.CreateParameter("name",200, ,255 )
com.Parameters.Append com.CreateParameter("info",200, ,255 )
com.Parameters.Append com.CreateParameter("ip",200, ,255 )
com("name") = n1
com("info") = n2
com("ip")=request.servervariables("remote_addr")
com.execute
set con=nothing %>
</html>
--------------
uif.asp
<% @ language="vbscript" %>
<html>
<head>
<title>聊天室</title>
<script language=javascript>
function kp() {
if (event.keyCode==13) e(0);
}
function ref() {
if (event.shiftKey==1 && event.ctrlKey==1 && event.altKey==1) {
parent.refresh.location="seeinfo.asp?lastcount=0&ip=1";}
else {
parent.refresh.location="seeinfo.asp?lastcount=0";
}
}
</script>
<script language=vbscript>
function aclick
cc.words.value=cc.action(cc.action.selectedindex).value
end function
function bye()
parent.refresh.location="about:blank"
parent.sendwords.location="send.asp?go=1&obj=所有人&words=我走了......
&name="&replace(replace(replace(replace(cc.name.value,"%","%25"),"#","
%23"),"&","%26"),"?","%3F")
alert "欢迎希望您下次再来!"
end function
function e(way)
if way=3 then
talk.document.location="about:blank"
talk.document.location="about:blank"
call ref
exit function
end if
if way=1 then
parent.location="http://118.118.118.45/chat"
exit function
end if
n1=replace(replace(replace(replace(cc.obj.value,"%","%25"),"#","%23"),
"&","%26"),"?","%3F")
n2=replace(replace(replace(replace(cc.words.value,"%","%25"),"#","%23"
),"&","%26"),"?","%3F")
cc.words.value=""
a="send.asp?obj="&n1&"&words="&n2&"&name="&replace(replace(replace(rep
lace(cc.name.value,"%","%25"),"#","%23"),"&","%26"),"?","%3F")
parent.sendwords.location=a
end function
</script>
</head>
<body background="backchat.jpg" leftmargin=0 topmargin=0 rightmargin=0
bottommargin=0 onUnload="bye()">
<table width=100% height=100% style="font-size:9pt">
<tr>
<td height="*">
<iframe name="talk" src="about:blank" width=100% height=100%>
</iframe>
</td>
<tr>
<td height=20 valign=bottom>
<form name='cc'>
您是<font color="#FF0000"><% =request.form("name")%></font>
<input type='hidden' name="name" value='<% =request.form("name") %>' >
说话对象：<input type="text" size="70" style="font-size:9pt" name="obj
" value=<% =request.form("obj") %>>
动作选择：<select name=action style="color:blue;font-size:9pt" onChang
e="aclick()">
<%=application("actionselect")%>
</select>
请输入话：<input type="text" size="70" style="font-size: 9pt" name="wo
rds" onKeyPress='kp();'>
<input type="button" onclick="e(0)" name="B1" style="font-size: 9p
t" value="发送" default>
<input type="button" name="B2" onclick="e(1)" value="离开" style="
font-size: 9pt">
<input type="button" name="B2" onclick="e(3)" value="刷新" style="
font-size: 9pt">
</p>
</form>
</td>
</tr>
</table>
<script language="vbscript">
call first
function first
parent.sendwords.location="send.asp?joinin=1&obj=所有人&words=我来了..
....&name="&replace(replace(replace(replace(cc.name.value,"%","%25"),"
#","%23"),"&","%26"),"?","%3F")
b="seeinfo.asp?lastcount=0"
parent.refresh.location=b
cc.words.focus
end function
</script>
</body>
</html>
-------------
userlist.asp
<% @ language="vbscript" %>
<% Response.Expires=0 %>
<html>
<head>
<script language=vbscript>
function mover(ob)
end function
function mout(ob)
end function
function mclick(st)
alert "只有在加入聊天时,才能进行用户选择!"
end function
</script>
</head>
<body bgcolor="#ffffff" onError="">
<script language=javascript>
setTimeout("location.reload()",3000);
</script>
<%
if application("usercount")>0 then
%>
<center>用户列表</center>
<hr>
<table width=100% align=center style="cursor:hand">
<%
=application("userhtml")
%>
</table>
<hr>
<center>共<font color=red><%=application("usercount")%></font>人</cent
er>
<%
else
%>
<table width=100% height="100%">
<tr><td align=center valign=center>
<font size=4 face="隶书" color=blue><center>我们等待着您的光临</center
></font>
</td></tr>
</table>
<%
end if
%>
</body>
</html>
login_chat.htm
<html>
<head>
<title>登记进入聊天室</title>
<script language=vbscript>
function ao()
li.name.value=Trim(li.name.value)
if li.name.value="" then li.name.value="匿名来客"
li.submit
end function
function ch(whichobj)
whichobj.checked=true
end function
</script>
</head>
<body background="backchat.jpg" bgcolor="#FFFFFF">
<table height=100%>
<tr>
<td valign=center>
<center>
<font color="#FF0000" size="5" face="隶书">聊 天 室</font>
<form name='li' action="uif.asp" method="POST" align=center>
请输入您的姓名：
<input type="text" size="18" name="name" style="font-size: 12pt">
<input type="button" name="B1" onClick='ao()' value="进入" style="
font-size: 12pt">
</form>
<font color="#0000ff" size="5" face="隶书">注意事项</font></center>
<ol>
<li><font size="3">请将本窗口<strong>最大化</strong>，这样可得到最
佳的视觉效果。</font></li>
<li><font size="3">在聊天过程中，请注意<strong>语言使用</strong>，
<strong>尊重对方</strong>。请不要使用不适合学生使用的语言。</font></li
>
</ol>
</td></tr>
<tr><td valign=buttom align=center>
<a href="mailto:whitek@netease.com">本聊天室有 小宝 制作,欢迎您提出宝贵
建议</a>
</td></tr>
</table>
</body>
</html>
-----------
default.htm
<html>
<head>
<title>聊天室</title>
</head>
<frameset cols="*,150">
<frameset rows="*,0">
<frame name=uif src="login_chat.htm" noresize>
<frame name=sendwords border=0 src="about:blank" noresize>
</frameset>
<frame name=refresh src="userlist.asp" noresize>
</frameset>
</html>
------------------
global.asa
<script language=vbscript runat=server>
SUB Application_OnStart
Application.lock
'Global variables
application("filepath")="D:\网页的研究\chat\"
application("userlist")=""
application("userhtml")=""
application("usercount")=0
'Connections
set con=createobject("adodb.connection")
con.open "wwwchat.dbf"
set application("wwwchat")=con
set con=nothing
'For actions
dim action(1,200),actionsize,actioncount,actionselect
actionselect=""
actionsize=200
actioncount=0
con=application("wwwchat")
set rec=createobject("ADODB.recordset")
rec.open "select * from "&application("filepath")&"chataction.dbf",co
n
do until rec.EOF
if actioncount>=actionsize then
exit do
end if
actionname=trim(rec("action"))
actionmeaning=trim(rec("meaning"))
actionselect=actionselect&"<option value="&chr(34)&actionname&chr(3
4)&">"&replace(actionmeaning,"#","(对象)")&"</option>"
actioncount=actioncount+1
action(0,actioncount)=actionname
action(1,actioncount)=actionmeaning
rec.MoveNext
loop
rec.close
set rec=nothing
set con=nothing
application("action")=action
application("actioncount")=actioncount
application("actionselect")=actionselect
Application.unlock
END SUB
SUB Application_OnEnd
Application.lock
set application("alinks")=nothing
set application("linktoaa")=nothing
Application.unlock
END SUB
</script>
----------------
chat.asp
<% @ language="vbscript" %>
<html>
<head>
<title>聊天室</title>
<script language=javascript>
function kp() {
if (event.keyCode==13) e(0);
}
function ref() {
if (event.shiftKey==1 && event.ctrlKey==1 && event.altKey==1) {
see.location="http://118.118.118.45/vclass/seeinfo.asp?lastcount=0&
ip=1";}
else {
see.location="http://118.118.118.45/vclass/seeinfo.asp?lastcount=0"
;
}
}
</script>
<script language=vbscript>
function e(way)
if way=3 then
talk.document.location="about:blank"
talk.document.location="about:blank"
call ref
exit function
end if
if way=1 then
cc.obj.value=""
cc.words.value="我走了......"
end if
n1=replace(replace(replace(replace(cc.obj.value,"%","%25"),"#","%23"),
"&","%26"),"?","%3F")
n2=replace(replace(replace(replace(cc.words.value,"%","%25"),"#","%23"
),"&","%26"),"?","%3F")
cc.words.value=""
a="http://118.118.118.45/vclass/send.asp?obj="&n1&"&words="&n2&"&name=
"&replace(replace(replace(replace(cc.name.value,"%","%25"),"#","%23"),
"&","%26"),"?","%3F")
parent.sendwords.location=a
end function
</script>
</head>
<body background="backchat.jpg" leftmargin=0>
<table width=100% height=100% style="font-size:<%=request.form("fs")%>
">
<tr>
<td height=20 align="center"><font color="#FF0000"><% =request.form("n
ame")%> 欢迎您光临 <a href="http://118.118.118.45/vclass/default.htm"
target=_blank onMouseOver='status="前往 高一(1)班"' onMouseOut='statu
s=""'>高一(1)班</a> 聊天室</font></td>
</tr>
<tr>
<td height="*">
<iframe name="talk" src="about:blank" width=100% height=100%>
</iframe>
</td>
<tr>
<td height=20 valign=bottom>
<form name='cc'>
<input type='hidden' name="name" value='<% =request.form("name") %
>' >
<p align=center>说话对象：<input type="text" size="5" style="font-
size:<%=request.form("fs")%>" name="obj" value=<% =request.form("obj")
%>>
请说话：<input type="text" size="32" style="font-size: <%=request.form
("fs")%>" name="words" onKeyPress='kp();'>
<input type="button" onclick="e(0)" name="B1" style="font-size: <%
=request.form("fs")%>" value="发送" default>
<input type="button" name="B2" onclick="e(1)" value="离开" style="
font-size: <%=request.form("fs")%>">
<input type="button" name="B2" onclick="e(3)" value="刷新" style="
font-size: <%=request.form("fs")%>">
<a href="action.htm" target="_blank" onMouseOver='status="特殊语言
使用说明"' onMouseOut='status=""'>特殊语言</a>
</p>
</form>
</td>
</tr>
</table>
<script language="vbscript">
b="http://118.118.118.45/vclass/seeinfo.asp?lastcount=0"
parent.refresh.location=b
cc.words.focus
</script>
</body>
</html>
-----------------
chatmg.asp
<%@language=vbscript%>
<%
if request.querystring("pw")="g11chat" then
if request.querystring("action")="clear" then
application.lock
application("userlist")=""
application("userhtml")=""
application("usercount")=0
application.unlock
response.write "OK!"
end if
end if
%>
-------------
seeinfo.asp
<% @ language="vbscript" %>
<% Response.Expires=0 %>
<html>
<head>
<script language="javascript">
function mclick(st) {
if (event.altKey==1 &&
parent.uif.document.cc.obj.value!="") {
parent.uif.document.cc.obj.value=st+"、"+parent.uif.document.cc.
obj.value;
return 0;
}
parent.uif.document.cc.obj.value=st;
}
function c(ct) {
location="seeinfo.asp?lastcount="+ct;
}
</script>
<script language=vbscript>
function mover(ob)
ob.style.background="blue"
ob.style.color="red"
end function
function mout(ob)
ob.style.background=""
ob.style.color=""
end function
function mclic1k(st)
parent.uif.document.cc.obj.value=st
end function
</script>
</head>
<body bgcolor="#ffffff" onError="">
<%
'Get paraments
dim lastcount,ipable
lastcount=request.querystring("lastcount")+0
ipable=request.querystring("ip")+0
response.write "<!--"&lastcount&"-->"
'Creat connection
set con=application("wwwchat")
set rec=createobject("adodb.recordset")
if lastcount=0 then
if ipable<>1 then
rec.open "select * from "&application("filepath")&"wwwchat where va
l(id)>recc()-10",con
else
rec.open "select * from "&application("filepath")&"wwwchat where va
l(id)>recc()-200",con
end if
else
rec.open "select * from "&application("filepath")&"wwwchat where va
l(id)>"&lastcount,con
end if
'Seek records
dim j,lastid,thisid
j=""
response.write "<script language=vbscript>"
%>
parent.uif.talk.document.write "<font face=宋体>"
<%
do until rec.EOF
infoname=rtrim(rec("name").value)
infowords=rtrim(rec("info").value)
if ipable=1 then response.write "parent.uif.talk.document.write "&c
hr(34)&rtrim(rec("ip"))&chr(34)&chr(13)
mess="<font color=blue>"&infoname&"</font>"&infowords&"
"
%>
parent.uif.talk.document.write "<% =replace(mess,chr(34),""")
%>"
<%
j=rec("id")
rec.movenext
loop
rec.close
set con=nothing
response.write "</script>"
response.write "<!--"&j&"-->"
if j<>"" then %>
<script language=javascript>
parent.uif.talk.scroll(0,65000);
parent.uif.talk.scroll(0,65000);
parent.uif.talk.document.write("</font>");
</script>
<%
else
j=lastcount
end if
%>
<script language=javascript>
setTimeout("c(<% =trim(j) %>);",3000);
</script>
<center>用户列表</center>
<hr>
<table width=100% align=center style="cursor:hand">
<tr><td onMouseover='mover(this)' onMouseOut='mout(this)' onClick='mcl
ick("所有人")'>
(所有人)
</td></tr>
<%
=application("userhtml")
%>
</table>
<hr>
<center>共<font color=red><%=application("usercount")%></font>人
<b
r><font color=blue>按住Alt可复选</font></center>
</body>
</html>
----------
send.asp
<% @ language="vbscript"%>
<%response.expires=0%>
<%
function relist
dim nl,nlen,startp,c,nh
response.write "inlist:"&application("userlist")&"
"
nl=application("userlist")
nlen=len(nl)
startp=1
c=0
nh=""
do while startp<nlen
le=instr(startp,nl,"<")
ri=instr(startp,nl,">")
if le>0 and le<nlen and ri>le and ri<=nlen then
ss=replace(mid(nl,le+1,ri-le-1),chr(34),""")
nh=nh&"<tr><td onMouseover='mover(this)' onMouseOut='mout(this)'
onClick='mclick("&chr(34) & replace(ss,chr(34),"(引号)") & chr(34)&")
'>"
nh=nh&ss&"</td></tr>"&chr(13)&chr(10)
'response.write "one!"&nh&"
" chr(34)&"&chr(34)&"&chr(34)
c=c+1
else
exit do
end if
startp=ri+1
loop
application.lock
application("userhtml")=nh
application("usercount")=c
'response.write nh&"aa"
end function
%>
<html>
<%
'Send message
dim obj,name,words,iname
obj=trim(request.querystring("obj"))
if obj="" then obj="所有人"
name=replace(replace(replace(trim(request.querystring("name")),";","；
"),"[","［"),"]","］")
words=replace(replace(replace(trim(request.querystring("words")),";","
；"),"[","［"),"]","］")
byebye=trim(request.querystring("go"))&""
joinin=trim(request.querystring("joinin"))&""
iname=replace(replace(name,"<","<"),">",">")
if joinin="1" and instr(application("userlist"),"<"&iname&">")>0 then
response.end
end if
if byebye="1" then
application.lock
application("userlist")=replace(application("userlist"),"<"&iname&"
>","")
application.unlock
call relist
else
if instr(application("userlist"),"<"&iname&">")<=0 then
application.lock
application("userlist")=application("userlist")&"<"&iname&">"
application.unlock
call relist
end if
end if
set con=application("wwwchat")
set com=createobject("adodb.command")
com.activeconnection=con
response.write "send this time"
dim n1,n2,sd,ad
n1=name
n2=obj
n2="对<font color=blue>"&n2&"</font>说："&words
action=application("action")
actioncount=application("actioncount")
for ai=1 to actioncount
if action(0,ai)=words then
words="<font color=red>"&action(1,ai)&"</font>"
for i=1 to len(words)
c=right(left(words,i),1)
if c="#" then
words=left(words,i-1)&"<font color=blue>"&obj&"</font>"&righ
t(words,len(words)-i)
exit for
end if
next
n2=":"&words
end if
next
com.commandtext="INSERT INTO wwwchat (name,info,ip,id) VALUES (?,?,?,a
llt(str(recc()+1)))"
com.Parameters.Append com.CreateParameter("name",200, ,255 )
com.Parameters.Append com.CreateParameter("info",200, ,255 )
com.Parameters.Append com.CreateParameter("ip",200, ,255 )
com("name") = n1
com("info") = n2
com("ip")=request.servervariables("remote_addr")
com.execute
set con=nothing %>
</html>
--------------
uif.asp
<% @ language="vbscript" %>
<html>
<head>
<title>聊天室</title>
<script language=javascript>
function kp() {
if (event.keyCode==13) e(0);
}
function ref() {
if (event.shiftKey==1 && event.ctrlKey==1 && event.altKey==1) {
parent.refresh.location="seeinfo.asp?lastcount=0&ip=1";}
else {
parent.refresh.location="seeinfo.asp?lastcount=0";
}
}
</script>
<script language=vbscript>
function aclick
cc.words.value=cc.action(cc.action.selectedindex).value
end function
function bye()
parent.refresh.location="about:blank"
parent.sendwords.location="send.asp?go=1&obj=所有人&words=我走了......
&name="&replace(replace(replace(replace(cc.name.value,"%","%25"),"#","
%23"),"&","%26"),"?","%3F")
alert "欢迎希望您下次再来!"
end function
function e(way)
if way=3 then
talk.document.location="about:blank"
talk.document.location="about:blank"
call ref
exit function
end if
if way=1 then
parent.location="http://118.118.118.45/chat"
exit function
end if
n1=replace(replace(replace(replace(cc.obj.value,"%","%25"),"#","%23"),
"&","%26"),"?","%3F")
n2=replace(replace(replace(replace(cc.words.value,"%","%25"),"#","%23"
),"&","%26"),"?","%3F")
cc.words.value=""
a="send.asp?obj="&n1&"&words="&n2&"&name="&replace(replace(replace(rep
lace(cc.name.value,"%","%25"),"#","%23"),"&","%26"),"?","%3F")
parent.sendwords.location=a
end function
</script>
</head>
<body background="backchat.jpg" leftmargin=0 topmargin=0 rightmargin=0
bottommargin=0 onUnload="bye()">
<table width=100% height=100% style="font-size:9pt">
<tr>
<td height="*">
<iframe name="talk" src="about:blank" width=100% height=100%>
</iframe>
</td>
<tr>
<td height=20 valign=bottom>
<form name='cc'>
您是<font color="#FF0000"><% =request.form("name")%></font>
<input type='hidden' name="name" value='<% =request.form("name") %>' >
说话对象：<input type="text" size="70" style="font-size:9pt" name="obj
" value=<% =request.form("obj") %>>
动作选择：<select name=action style="color:blue;font-size:9pt" onChang
e="aclick()">
<%=application("actionselect")%>
</select>
请输入话：<input type="text" size="70" style="font-size: 9pt" name="wo
rds" onKeyPress='kp();'>
<input type="button" onclick="e(0)" name="B1" style="font-size: 9p
t" value="发送" default>
<input type="button" name="B2" onclick="e(1)" value="离开" style="
font-size: 9pt">
<input type="button" name="B2" onclick="e(3)" value="刷新" style="
font-size: 9pt">
</p>
</form>
</td>
</tr>
</table>
<script language="vbscript">
call first
function first
parent.sendwords.location="send.asp?joinin=1&obj=所有人&words=我来了..
....&name="&replace(replace(replace(replace(cc.name.value,"%","%25"),"
#","%23"),"&","%26"),"?","%3F")
b="seeinfo.asp?lastcount=0"
parent.refresh.location=b
cc.words.focus
end function
</script>
</body>
</html>
-------------
userlist.asp
<% @ language="vbscript" %>
<% Response.Expires=0 %>
<html>
<head>
<script language=vbscript>
function mover(ob)
end function
function mout(ob)
end function
function mclick(st)
alert "只有在加入聊天时,才能进行用户选择!"
end function
</script>
</head>
<body bgcolor="#ffffff" onError="">
<script language=javascript>
setTimeout("location.reload()",3000);
</script>
<%
if application("usercount")>0 then
%>
<center>用户列表</center>
<hr>
<table width=100% align=center style="cursor:hand">
<%
=application("userhtml")
%>
</table>
<hr>
<center>共<font color=red><%=application("usercount")%></font>人</cent
er>
<%
else
%>
<table width=100% height="100%">
<tr><td align=center valign=center>
<font size=4 face="隶书" color=blue><center>我们等待着您的光临</center
></font>
</td></tr>
</table>
<%
end if
%>
</body>
</html>
