神马品牌网末地传送门里面有什么:我要做一个简单的聊天室,用asp做,能实现聊天和在线人数统计就行
来源：百度文库 编辑：神马品牌网 时间：2024/04/29 04:20:54
<%'---------------------------------------------------------------
' AspStudio_Codepage="936"
' 上面这行是软件使用的代码页标记，请不要删除。详情请参考帮助文件。
'
' 档案名称：Chat.asp
' 原创作者：Jason
' 作者邮件：
' 创建日期：星期三，2006年03月15日 21:50:58
' 版权所有(C)
'--------------------------------------------------------------%>
<!-- #include file="Const.inc"-->
<%
'Application变量说明
'application("Member")="" '聊天者昵称
'application("Num")=0 '聊天者人数
'application("Lines")=0 '聊天内容行数
'application("Message")="" '聊天内容
'获得昵称、幸运色、进入方式
PetName=trim(request("PetName"))
TextColor=request("TextColor")
EnterWay=request("EnterWay")
if session("Register")<>"Yes" then '如果没有注册
'昵称为空，重定向到登录页面
if PetName="" then
response.Redirect("Register.asp?P=昵称不能为空")
end if
if instr(application("Member"),">"&PetName& "</a>") then
Prompt="昵称"& PetName & "已经被别人使用"
response.Redirect("Register.asp?P="& Prompt)
end if
if application("Num")>MaxNum then
response.Write("Register.asp?P=对不起！聊天室人已满。")
else
application.Lock
'定义新网友的超链接，单击它后可以改变发言的对象
NewMember="<a herf=Message.asp?ToName="& PetName & ">" & PetName & "</a>"
application("Member")=application("Member") & NewMember & "<br>"
application("Num")=application("Num")+1
'定义一条发言信息，告诉所有人新加入一个成员
NewLine="<font color=" & TextColor & ">来自"
NewLine=NewLine & request.ServerVariables("REMOTE_ADDR")'取客户端IP
NewLine=NewLine & "的<font color=Red>" &PetName& "</font>"
NewLine=NewLine & EnterWay & "聊天室</font>"
'如果发言没有达到最大条数，直接加入发言
if application("lines")<MaxLine then
application("Message")=application("Message") & NewLine & "<br>"
application("Lines")=application("Lines")+1
else
FirstBR=instr(application("Message"),"<br>")+4
application("Message")=Mid(application("Message"),firstBR) & NewLine & "<br>"
end if
application.UnLock
'保存个人信息
session("Register")="Yes"
session("PetName")=PetName
session("TextColor")=TextColor
session("NewMember")=NewMember
end if
end if
%>
<HTML>
<HEAD>
<Title>心灵驿站聊天室</Title>
</HEAD>
<frameset rows="33,*,35" cols="*">
<frame src="Title.asp" scrolling="auto" name="Title" marginwidth="5" marginheight="2" noresize target="_self">
<frameset cols="*,100">
<frame src="Show.asp" scrolling="auto" name="Show" target="_self">
<frame src="Member.asp" scrolling="auto" name="Member" noresize marginwidth="1" marginheight="5" target="Message">
</frameset>
<frame src="Message.asp" marginwidth="5" marginheight="0" scrolling="auto" noresize name="Message" target="Show">
</frameset>
</HTML>
Const.inc：
<%
Const MaxNum=256
Const MaxLine=21
%>
<%'---------------------------------------------------------------
' AspStudio_Codepage="936"
' 上面这行是软件使用的代码页标记，请不要删除。详情请参考帮助文件。
'
' 档案名称：Message.asp
' 原创作者：Jason
' 作者邮件：
' 创建日期：星期三，2006年03月15日 22:29:22
' 版权所有(C)
'--------------------------------------------------------------%>
<!-- #include file="Const.inc"-->
<HTML>
<HEAD>
<Title>发言区</Title>
<base target="Show">
</HEAD>
<BODY bgcolor="#669999">
<%
if session("Register")<>"Yes" then
%>
<script language="vbscript">
MsgBox("请先登录!")
</script>
<p align="center"><a href="Register.asp" target="_top">请先登录</a></p>
<%
else
ToName=trim(request("ToName"))
Way=trim(request("Way"))
Words=trim(request("Words"))
if ToName="" then
ToName="所有人"
end if
if Way="" then
way="微笑着"
end if
if Words<>"" then
NewLine="<font color="& session("TextColor") & session("PetName")
NewLine=NewLine& "</font>向<font color=red>" & ToName & "</font>" & Way
NewLine=NewLine & "说：<font color="& session("TextColor")& ">" &Words & "</font>"
application.Lock
if application("Lines")<MaxLine then
application("Message")=application("Message") & NewLine & "<br>"
application("Lines")=application("Lines")+1
else
FirstBR=instr(application("Message"),"<br>")+4
application("Message")=mid(application("Message"),FirstBR)& NewLine &"<br>"
end if
application.UnLock
end if
%>
<form method="post" action="Message.asp">
<center>
<%=Session("PetName")%>
向<input name="ToName" TYPE="Text" size="12" value="<%=ToName%>">
<select name="Way" size="1">
<option <% IF WAY="微笑着" THEN RESPONSE.WRITE("SELECTED")%>>微笑着<option>
<option <% IF WAY="开怀大笑着" THEN RESPONSE.WRITE("SELECTED")%>>开怀大笑着<option>
<option <% IF WAY="冷笑着" THEN RESPONSE.WRITE("SELECTED")%>>冷笑着<option>
<option <% IF WAY="宛然一笑" THEN RESPONSE.WRITE("SELECTED")%>>宛然一笑<option>
<option <% IF WAY="微笑着" THEN RESPONSE.WRITE("SELECTED")%>>阴阳怪气地<option>
<option <% IF WAY="嚎啕大笑着" THEN RESPONSE.WRITE("SELECTED")%>>嚎啕大笑着<option>
<option <% IF WAY="擦干眼泪后" THEN RESPONSE.WRITE("SELECTED")%>>擦干眼泪后<option>
<option <% IF WAY="小心翼翼地" THEN RESPONSE.WRITE("SELECTED")%>>小心翼翼地<option>
<option <% IF WAY="埋怨着" THEN RESPONSE.WRITE("SELECTED")%>>埋怨着<option>
</select>说：<!--WEBBOT BOT="Validation" S-DADA-TYPE="String" B-VALUE-REQUIRED="TRUE" I-MINIMUM-LENTH="1" I-MAXIMUM-LENGTH="40"-->
<INPUT NAME="Words" type="text" size="30" maxlength="40"><input type="submit" value="发言" name="submit">
<a href="Leave.asp" target="_top">离开聊天室</a>
</center>
</form>
<%end if%>
</BODY>
</HTML>
<%'---------------------------------------------------------------
' AspStudio_Codepage="936"
' 上面这行是软件使用的代码页标记，请不要删除。详情请参考帮助文件。
'
' 档案名称：Register.asp
' 原创作者：Jason
' 作者邮件：
' 创建日期：星期三，2006年03月15日 21:29:24
' 版权所有(C)
'--------------------------------------------------------------%>
<HTML>
<HEAD>
<Title>聊天室登录</Title>
</HEAD>
<BODY bgcolor="#C0C0C0">
<%
if session("Register")="Yes" then
response.Redirect("Chat.asp")
end if
P=request("P")
if P="" then
P="请输入你的昵称并选择你喜欢的颜色，然后按“登录”按钮"
end if
%>
<center>
<p><font face="华文彩云" size="+6" color="#800000">聊天室登录</font></p>
<%=P%>
<form method="post" action="Chat.asp">
<p>昵称：<!--webbot bot="validation" S-data-type="String" b-value-required="true" i-maximum-length="12"-->
<input type="text" name="PetName" size="20" maxlength="12">幸运色：
<select name="TextColor" size="1">
<option selected value="#880088">默认颜色</option>
<option value="#0000ff">海天一色</option>
<option value="#8a2be2">紫罗兰色</option>
<option value="#d2691e">巧克力色</option>
<option value="#6495ed">矢车菊兰</option>
<option value="#556b2f">暗橄榄绿</option>
<option value="#ffe4e1">模糊玫瑰</option>
<option value="#0000cc">深海兰色</option>
<option value="#006600">生命常青</option>
</select>
进入方式：<select size="1" name="EnterWay">
<option selected>快乐的跑进</option>
<option>大驾光临</option>
<option>一路小跑地来到</option>
<option>哼着小曲迈进</option>
<option>一瘸一拐的迈进</option>
</select>
</p>
<p><input type="submit" value="登录" name="B1"><input type="reset" value="清除" name="B2"></p>
</form>
</center>
</BODY>
</HTML>
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Refresh" content="10">
<title>显示聊天室内容</title>
<base target="_self">
</head>
<body bgcolor="#C0C0C0">
<%Application("Message")%>
</body>
</html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>聊天室标题</title>
<BASE target="_self">
</head>
<body bgcolor="#99FFCC">
<P align="center"><font size="5"><strong><font face="华文彩云">心灵驿站</font></strong><font face="华文行楷" color="#80080">聊天室</font></font>
</body>
</html>
<!-- #include file="Const.inc"-->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>谢谢使用心灵驿站聊天室</title>
</head>
<body>
<%
'定义要删除的成员
DeleteMember = Session("Member")
'查找要删除的成员在Application("Member")中的起始位置何中了位置
BeginPos = Instr(Application("Member"),DeleteMember)
EndPos = BeginPos+Len(DeletMember)+4 '4=Len("<BR>")
if BeginPos >0 then '如果找到，则删除成员
Application.Lock '锁定Application ,别人不能改动
LeftMember =Left(Application("Member")),BeginPos-1) '前半部分
RightMember =Left(Application("Member"),EndPos) '后半部分
Application("Member") = LeftMember & RightMember
'在线人数减1
Application("Num") = Application("Num")-1
'输出一行内容，以说明有成员离开聊天室
NewLine ="<font color = red>"&Session("PetName")&"</font>"
NewLine =NewLine & "<font color ="&Session("TextColor")
NewLine =NewLIne &">转身离开了聊天室！</font>"
if Application("Lines")<MaxLine then
Application("Message") =Application("Message")& NewLine &"<br>"
Application("Message") =Application("Lines")+1
else
FirstBR =Instr(Application("Message"),"<BR>")+4
Application("Message") = Mid(Application("Message"),FirstBR)&NewLine&"<BR>"
end if
Application.UnLock '解锁Application，其他人可以访问
'结束Session
Session.Abandon
response.Redirect("Register.asp?P=谢谢使用心灵驿站聊天室，欢迎再次光临！")
end if
response.Redirect("Register.asp")
%>
</body>
</html>
<html>
<head>
<meta http-equiv=refresh content="10">
<title>在线人数</title>
<base target="Message">
</head>
<body bgcolor="#99FF99">
在线<%=Application("Num")%>人<center><a href="message.asp?Toname=所有人">所有人</a><br>
<%=Application("Member")%>
</center>
</body>
</html>
纯VBScript的聊天室是不可能的，必须用到JavaScript。