刷新帧，文件名fresh.asp

刷新帧：文件名fresh.asp

<%
Option Explicit
dim msg,tmsg,ws,action,user,whoto,tcolor,kicklist,chatpoin,chatcomm,chatdata,sendid,i,reciid
dim tsecretly,thidename,dispstr,tchatpoin,tuserpoin,tchatcomm,j

dim sendname,address1,reciname
user=request("user")
whoto=request.form("whoto")
tmsg=request.form("SAYS")
tmsg=replace(tmsg,"/","//")
tmsg=replace(tmsg,",","/,")
tmsg=replace(tmsg,"<","<")    '屏蔽所有的Html标记
tmsg=replace(tmsg,"<img","<img")   '放开<img标记
tmsg=replace(tmsg,"<b","<b")   '放开<b标记
if request.form("ws")="on" then
  ws=true
else
  ws=false
end if

kicklist=application("kicklist")
'是否被踢用户
if instr(kicklist,"'#"&user&"'")>0 then
  response.write "<script>parent.top.location='kickout.htm';</script>"
  response.end
end if
if instr(kicklist,"'"&Request.ServerVariables("remote_addr")&"'")>0 then
  response.write "<script>parent.top.location='kickout.htm';</script>"
end if
chatpoin=application("chatpoin")  '聊天室指针
chatcomm=application("chatcomm")  '聊天室内容
chatdata=application("chatdata") '聊天室用户数据
sendid=-1
reciid=-1
for i=0 to 50
  if chatdata(i,0)=user and chatdata(i,1)=Request.ServerVariables("remote_addr") then sendid=i '注意，在些检查IP地址，预防被穿墙
  if chatdata(i,0)=whoto then reciid=i
next
if sendid=-1 then
  response.write "用户没有进入聊天室"
  response.end
end if
chatdata(sendid,4)=(chatdata(sendid,4) mod 104) '置标志，预防被自动踢出聊天室
msg=right(time,8)&","&user&","&request.form("action")&","&whoto&","&request.form("color")
if ws then
msg=msg&",1"
else
msg=msg&",0"
end if
msg="'"&msg&","&tmsg
if reciid=-1 and whoto<>"所有人" then ws=true:reciid=sendid:msg=msg&"<font color=red>("&whoto&"不在此聊天室）</font>"
msg=msg&"'<br>"
if tmsg<>"" then
  if ws then '耳语
  if whoto<>"所有人" then chatdata(sendid,3)=chatdata(sendid,3)&msg
  if reciid<>-1 and sendid<>reciid then  chatdata(reciid,3)=chatdata(reciid,3)&msg
   application.lock
     application("chatdata")=chatdata
   application.unlock
  end if
  if not ws or ws and whoto="所有人" then  '属于全部人的数据
    if chatpoin=49 then
       chatpoin=0  '数组回头，循环调用
       call checkname
    else
       chatpoin=chatpoin+1
    end if
    chatcomm(chatpoin)=msg   '将内容写进application内
    application.lock
      application("chatcomm")=chatcomm  
      application("chatpoin")=chatpoin
    application.unlock
  end if
end if

%><meta http-equiv="refresh" content="3; URL=refresh.asp?user=<% =user %>"><%
tsecretly=chatdata(sendid,3)  '取私聊内容
thidename=chatdata(sendid,5)  '取隐藏名单
dim tmpstr
if tsecretly<>"" then  '显示私聊内容
  response.write thidename
  dispstr=""
  dim temps
  tsecretly=split(tsecretly,"<br>")
  for i=0 to ubound(tsecretly)-1
    tmpstr=split(tsecretly(i),",")
    if instr(thidename,",'"&tmpstr(3)&"'")<1 then dispstr=dispstr&","&replace(tsecretly(i),"<br>","")
  next
  chatdata(sendid,3)=""  '清空私聊内容
end if

tuserpoin=chatdata(sendid,2)  '用户指针
tchatpoin=chatpoin
if tchatpoin<>tuserpoin then '显示公聊内容
  if tchatpoin<tuserpoin then tchatpoin=tchatpoin+50  '修正用户指针
  if (chatdata(sendid,4) mod 2)=1 then  '请勿打挠开关打开了
    for i=tuserpoin+1 to tchatpoin
      j=(i mod 50)  '修正指针
      if chatcomm(j)<>"" then
        tmpstr=split(chatcomm(j),",")
        if instr(thidename,",'"&tmpstr(3)&"'")<1 and ((tmpstr(3)=user or tmpstr(3)="所有人")) then dispstr=dispstr&","&replace(chatcomm(j),"<br>","")
      end if
    next
  else
    for i=tuserpoin+1 to tchatpoin
      j=(i mod 50)  '修正指针
      if chatcomm(j)<>"" then
        tmpstr=split(chatcomm(j),",")
        if instr(thidename,",'"&tmpstr(3)&"'")<1 then dispstr=dispstr&","&replace(chatcomm(j),"<br>","")
      end if
    next
  end if
  chatdata(sendid,2)=chatpoin
end if

response.write "<script language='javascript'>"&chr(13)&chr(10)
if dispstr<>"" then
  response.write "for(var i=0;i<parent.comm.length;i++){delete parent.comm[i];}"&chr(13)&chr(10)
  dispstr="parent.comm=new Array("&mid(dispstr&");",2)
  response.write dispstr&chr(13)&chr(10)
  response.write "parent.writecomm();"&chr(13)&chr(10)
end if
if (chatdata(sendid,4) mod 8)>=4 then  '有新用户加进，刷新名单
  chatdata(sendid,4)=chatdata(sendid,4) mod 4
  response.write "top.u.location.reload();"
end if
application.lock
  application("chatdata")=chatdata
application.unlock
response.write "</script>"

sub checkname
'处理没有太久没有连线取内容的用户
dim onliuser,uleave
uleave=false
onliuser=application("onliuser")
chatdata=application("chatdata")
for i=0 to 50
   if chatdata(i,4)>98 then  '用户太久没有连接，清空此用户数据
     application.lock
       application("onliuser")=replace(application("onliuser"),",'"&chatdata(i,0)&"'","")
     application.unlock
     chatdata(i,0)=""
     chatdata(i,1)=""
     uleave=true
   else
     if chatdata(i,0)<>"" then
       chatdata(i,4)=chatdata(i,4)+104  '给用户加上标志
     end if
   end if
next
if uleave then
   for i=0 to 50
     chatdata(i,4)=(chatdata(i,4) mod 4)+4  '通知其它用户刷新名单
   next
end if
application.lock
   application("chatdata")=chatdata
application.unlock
end sub
%>