精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● ASP>>ASP范例>>一个不错的聊天室例子

主题:一个不错的聊天室例子
发信人: lovezero()
整理人: jackyz(1999-07-22 12:13:30), 站内信件
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="隶书">聊 天 室

<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="隶书">注意事项</center>


        
  1. 请将本窗口<strong>最大化</strong>,这样可得到最
    佳的视觉效果。

  2.     
  3. 在聊天过程中,请注意<strong>语言使用</strong>,
    <strong>尊重对方</strong>。请不要使用不适合学生使用的语言。
    >

</td></tr>
<tr><td valign=buttom align=center>
本聊天室有 小宝 制作,欢迎您提出宝贵
建议

</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"><% =request.form("n
ame")%> 欢迎您光临 <a href="http://118.118.118.45/vclass/default.htm"
target=_blank onMouseOver='status="前往 高一(1)班"' onMouseOut='statu
s=""'>高一(1)班 聊天室
</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=""'>特殊语言
    </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 ""
<%
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=""&infoname&""&infowords&"<br>"
%>
   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("
");
</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>共<%=application("usercount")%>人<br><b
r>按住Alt可复选</center>
</body>
</html>
_----------
send.asp
<% @ language="vbscript"%>
<%response.expires=0%>
<%
function relist
dim nl,nlen,startp,c,nh
response.write "inlist:"&application("userlist")&"<br>"
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&"<br>"  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,"<","<"),">","&gt;")
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="对"&n2&"说:"&words


action=application("action")
actioncount=application("actioncount")
for ai=1 to actioncount
if action(0,ai)=words then
   words=""&action(1,ai)&""
   for i=1 to len(words)
       c=right(left(words,i),1)
       if c="#" then
          words=left(words,i-1)&""&obj&""&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'>
您是<% =request.form("name")%><br>
<input type='hidden' name="name" value='<% =request.form("name") %>' >

说话对象:<input type="text" size="70" style="font-size:9pt" name="obj
" value=<% =request.form("obj") %>><br>
动作选择:<select name=action style="color:blue;font-size:9pt" onChang
e="aclick()">
<%=application("actionselect")%>
</select><br>
请输入话:<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>共<%=application("usercount")%>人</cent
er>
<%
else
%>
<table width=100% height="100%">
<tr><td align=center valign=center>
<center>我们等待着您的光临</center
>

</td></tr>
</table>
<%
end if
%>

</body>
</html>
-----------
另外还有wwwchat.dbf的表,结构为
name c(30) info c(254) id c(10) ip c(20)

还有两个动作文件我就不贴了,希望对您有参考价值,有什么感想和问题,可以
贴贴纸,我会尽量回答。 

--
         |  |        罐水之王(我生气就灌水)
        /    \
       /~~~~~~\
      /        \
     (__________)

※ 来源:.月光软件站 http://www.moon-soft.com.[FROM: 210.74.253.208]

[关闭][返回]