msglist.asp

AJAX聊天室 可以实现刷新 AJAX

<%
Response.Addheader "Content-Type","text/html; charset=UTF-8"
Response.Buffer = True
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
XH_FaceUrl="/images/face/"
'过滤
XH_Robot="小叮当"

Function HtmlEnCode(fString)
//普通替换
fString = Replace(fString, ">", "&gt;")
fString = Replace(fString, "<", "&lt;")
fString = Replace(fString, "我操", "＊＊")
fString = Replace(fString, "我草", "＊＊")
fString = Replace(fString, "去死", "＊＊")
fString = Replace(fString, "你妈", "＊＊")
fString = Replace(fString, "垃圾", "＊＊")
fString = Replace(fString, "系统信息", "＊＊＊＊")
fString = Replace(fString, "|", "｜")
fString = Replace(fString, "$", "￥")
fString = Replace(fString, "#", "＃")
//正则
Dim oReg
Dim strTmp 
Set oReg=New RegExp 
strTmp=fString
oReg.Global=True 
oReg.IgnoreCase=True
oReg.Pattern="\[F([0-9]+)\]"
'oReg.Pattern="\[Img\=([a-zA-Z0-9]+)\,([a-zA-Z0-9\-\_\/\:\.\?\&\%\+\=\u4E00-\u9FA5]+)\,([a-zA-Z0-9\-\_\/\:\.\?\&\%\+\=\u4E00-\u9FA5]+)\]([a-zA-Z0-9\u4e00-\u9fa5]+)\[\/Img\]"
strTmp=oReg.Replace(strTmp,"<img src='"&XH_FaceUrl&"$1.gif' class='face' align=top>")

HtmlEnCode=strTmp
Set oReg=nothing
End Function

'截取信息
Function GetKey(MsgList,Start)
filearray=split(MsgList,Start)
GetKey=filearray(1)
End Function

'房间编号
action=request("action")
Id=request("Id")
If Len(Id) = 0 Then Id = "F1"
MsgNum=Id&"_Num"

Uname=request("Uname")
Color=request("Color")
if Uname="" then Uname="游客"
Msg=HtmlEnCode(request.form("Msg"))
Yname=request("Yname")
if Yname="" then Yname="所有人"
Mtype=0		'信息类型 0普通1私聊2系统密语3系统公开

'=======================================
'$1|用户名|目标人|聊天信息|0普通1私聊2系统密语3系统公开
'=======================================
'初始化计数器
if Application(MsgNum)="" or Application(Id)="" then Application(MsgNum)=0
ListNum=Application(MsgNum)

If Msg<>"" and Uname<>"" Then
Application.Lock
If Msg="clear258358" Then
Application(Id) = ""
Application(MsgNum)=""
else
'信息记录
Application(MsgNum)=Application(MsgNum)+1
Question=Msg
if Color<>"" and Color<>"000000" then Msg="<font color=#"&Color&">"&Msg&"</font>"
MsgHtml="$"&Application(MsgNum)&"|"&Uname&"|"&Yname&"|"&Msg&"|"&Mtype
Application(Id)=Application(Id)+MsgHtml
'机器人回复开始
if Yname=XH_Robot then
%><!--#include file="MsgRobot.asp"--><%
if RobotMsg="无" then
RobotNum=int(gen_key(3)/3)

if IsNumeric(Question) then
RobotMsg="你打这么一串数字过来,我哪知道是什么啊"
elseif Asc(Question)>Asc("a") and Asc(Question)<Asc("z") then
RobotMsg="这是English?我一句也没看懂哇"
elseif RobotNum>250 then
RobotMsg="<img src='"&XH_FaceUrl&"54.gif' class='face' align=top>主人老是说我还小,不让我和陌生人说话..."
elseif RobotNum>134 then
RobotMsg=g(Question)
else
RobotMsg="<img src='"&XH_FaceUrl&RobotNum&".gif' class='face' align=top>"
end if

end if
Application(MsgNum)=Application(MsgNum)+1
MsgHtml="$"&Application(MsgNum)&"|"&XH_Robot&"|"&Uname&"|"&RobotMsg&"|"&Mtype
Application(Id)=Application(Id)+MsgHtml


end if
'机器人回复结束

end if
Application.Unlock
end if
MessNum=Application(MsgNum)

'用户已获取的信息数量
Onum=request("Onum")
if Onum=0 then
Onum=MessNum-1
if Onum<0 then Onum=0
end if

Onum=int(Onum)+1
if MessNum=>Onum then
MessList="$"&Onum&GetKey(Application(Id),"$"&Onum)
response.write MessList
end if
'达到100条信息自动清空信息
'if MessNum>200 then
'Application.Lock
'Application(Id)="$180"&GetKey(Application(Id),"$"&180)
'Application.Unlock
'end if
%>