<% Call FortxtChat dim ID ID=trim(Request.QueryString("ID")) if ID="" or IsNumeric(ID)=false then Response.write "" Call Error("

不存在的聊天室！") end if dim page page=trim(Request.QueryString("page")) if page="" or IsNumeric(page)=false then page=1 end if page=abs(int(page)) dim pa,TM pa=trim(request("pa")) TM=trim(request("TM")) if TM="" or IsNumeric(TM)=false then TM=40 end if if pa="" or IsNumeric(pa)=false then pa=10 end if pa=clng(pa) TM=clng(TM) dim Chatname,roomAdmin,roomAdmin2,Suxin,Chat,cBeon,Disallow,Title set rs=server.createobject("adodb.recordset") rs.open "select roomname,roomAdmin,roomAdmin2,Suxin,Chattxt,Chatnum,Chathall,Title,gruid, mmtext from Chat where ID="&ID,conn,1,2 if rs.eof then rs.close set rs=nothing Response.write "" Call Error("

不存在的聊天室！") end if ChatAdmin = rs("roomAdmin") roomAdmin2 = rs("roomAdmin2") mmtext = rs("mmtext") chatname= rs("roomname") Suxin = rs("Suxin") Chat = rs("Chattxt") cBeon = rs("Chatnum") Disallow = rs("Chathall") Title = rs("Title") gruid = rs("gruid") rs.close set rs=nothing '管理员 dim AdminID AdminID = 0 if Instr(","&ChatAdmin&",",","&myid&",") > 0 then AdminID = myid end if if ubb(roomAdmin2)<>0 then chatmm=request("chatmm") if request("chatmm")<>"" then if ubb(roomAdmin2)=ubb(chatmm) then set rs=server.createobject("adodb.recordset") rs.open "select mmtext from Chat where ID="&ID,conn,1,2 if Instr(","&rs("mmtext")&",",","&myid&",") = 0 then if rs("mmtext") <> "" then rs("mmtext") = rs("mmtext")&","&myid else rs("mmtext") = myid end if rs.update end if rs.close set rs=nothing else Response.write "

" Response.write "密码不对" Response.write "
返回" Response.write "

" Response.end end if end if end if if Instr(","&Disallow&",",","&myid&",") > 0 then conn.close set conn=Nothing Response.write "

" Response.write "您被禁止进入此聊天室." Response.write "
返回" Response.write "

" Response.end end if if roomadmin2<>0 and keys<>1 and mmtext<>"" then if Instr(","&mmtext&",",","&myid&",") <= 0 then conn.close set conn=Nothing Response.write "

" Response.write "此聊天室已加密.请输入密码进入
" if request("chatmm")<>"" then Response.write "请再输入一次密码
" end if response.write"密码
" response.write"
" response.write"确定进入" response.write"" response.write"
" Response.write "
返回" Response.write "

" Response.end end if end if if TM<>0 then Response.write ""&chr(13) Response.write ""&chr(13) else Response.write ""&chr(13) end if Response.write "

"&chr(13) '检查有几条新留言 dim newguest newguest = 0 IF myid > 0 THEN newguest = ForNewGuest(myid) END IF if newguest > 0 then Response.write "您有"&newguest&"条新消息
"& chr(13) end if '更新页面 if ChatID <> ID then conn.execute("update Users Set ChatID = "&ID&" where ID="&myid) '更新在线人数 end if if Title<>"" then Response.write UBB(Title)&"
"&chr(13) Response.write "发言 "&chr(13) Response.write " 邀请"&chr(13) Response.write "刷新"&chr(13) Response.write "离开
"&chr(13) dim Chattxt,n,maxvp,pagechatnum maxvp=0 pagechatnum=pa if Chat<>"" then Chat = Replace(Chat,"\","") Chat = Replace(Chat,"＼","") Chat = Replace(Chat,chr(13),"") Chat = Replace(Chat,chr(10),"") if InStr(Chat,",") then Chattxt=split(Chat,",") maxvp=abs(int(ubound(Chattxt)/pagechatnum) + 1) n=0 n = page*pagechatnum - pagechatnum do until n = (ubound(Chattxt)+1) or n = page*pagechatnum Response.write n+1&"."&chatusb(Chattxt(n))&"
"&chr(13) n=n+1 loop else Response.write "1."&chatusb(Chat)&"
"&chr(13) end if end if Response.write ""&chr(13) Response.write "
快速发言"&chr(13) Response.write ""&chr(13) Response.write ""&chr(13) Response.write ""&chr(13) Response.write ""&chr(13) Response.write ""&chr(13) Response.write "" Response.write "
"&chr(13) if page < maxvp then Response.write "下一页 "&chr(13) end if if page >1 then Response.write "上一页"&chr(13) end if Response.write "
刷新:手动 " Response.write "10 " Response.write "30 " Response.write "50秒" Response.write "
页面:10 " Response.write "15 " Response.write "20条/页" if myid = AdminID or keys = 1 or clng(gruid)=adminzone then Response.write "
管理聊天室"&chr(13) end if Response.write "
管理员:" if ChatAdmin <> "" then dim ChatAdmins,AdminNames,c ChatAdmin = replace(ChatAdmin,"，",",") if right(ChatAdmin,1)="," then ChatAdmin = replace(ChatAdmin,right(ChatAdmin,1),"") end if ChatAdmins = split(ChatAdmin,",") for c = 0 to ubound(ChatAdmins) dim username set rs=server.createobject("ADODB.Recordset") rs.Open "select ID,name from Users where ID = "&ChatAdmins(c),conn,1,1 if not rs.eof then username=rs("name") end if rs.close set rs=nothing Response.write ""&username&""&chr(13) next end if conn.close set conn=Nothing Response.write "
地盘>>" if gruid<>0 then Response.write "群组>>" else Response.write "大厅>>" end if Response.write "社区
(c) "&Request.ServerVariables("SERVER_NAME")&"["&String(2-Len(hour(now)),"0") & hour(now) &":"&String(2-len(minute(now)),"0") & minute(now)&"]" Response.write "

" function chatusb(str) str=trim(str) if IsNull(str) then exit function str = replace(str, "sid=@@sid@@", "TM="&TM&"&Pa="&Pa&"&sid="&sid&"") Set re=new RegExp re.IgnoreCase =true re.Global=True re.pattern="($img)$(.{5,}?)$/img$" str= re.Replace(str,"

") re.pattern="(\[img\])(.[^\[]*)(\[\/img\])" str= re.Replace(str,"

") re.pattern="($URL$)(.[^$]*)(\(\/URL$)" str= re.Replace(str,"$2") re.pattern="($URL=(.[^\(]*)$)(.[^$]*)(\(\/URL$)" str= re.Replace(str,"$3") re.pattern="(\[url\])(.[^\[]*)(\[\/url\])" str= re.Replace(str,"$2") re.pattern="(\[url=(.[^\]]*)\])(.[^\[]*)(\[\/url\])" str= re.Replace(str,"$3") re.pattern="($c$)(.[^\[]*)($\/c$)" str= re.Replace(str,"$2") re.pattern="($c=(.[^\]]*)$)(.[^\[]*)($\/c$)" str= re.Replace(str,"$3") re.pattern="($u$)(.[^\[]*)($\/u$)" str= re.Replace(str,"$2") re.pattern="($b$)(.[^\[]*)($\/b$)" str= re.Replace(str,"$2") re.pattern="($i$)(.[^\[]*)($\/i$)" str= re.Replace(str,"$2") re.Pattern="(\\\\)" str= re.Replace(str,"
") set re=nothing chatusb=str end function %>