<!--#include file="../Inc.asp"-->
<!--#include file="../ydzq.asp"-->
<%
call head()

if TM<>0 Then
Call cardz(""&Chatname&"-"&waptitle&"","chatroom.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;t="&left(int(timer()),4)&"&amp;saytk="&saytk&"")

Else
Call saycardd(""&Chatname&"-"&waptitle&"")
end if

Call FortxtChat
dim ID
ID=trim(Request.QueryString("ID"))
if ID="" or IsNumeric(ID)=false then
if saytk<>1 then
Response.write "<title>错误</title></head><body><body bgcolor="""&yanse12&"""><p>不存在的聊天室！"
else
   Response.write "<card title=""错误"">"
   Call Error("<p>不存在的聊天室！")
 end if
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
if saytk<>1 then
Response.write "<title>错误</title></head><body><body bgcolor="""&yanse12&"""><p>不存在的聊天室！"
else
  Response.write "<card title=""错误"">"
  Call Error("<p>不存在的聊天室！")
end if
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
  if saytk<>1 Then
  Response.write "<title>错误</title></head><body><body   bgcolor="""&yanse12&"""><p>"
  else
  Response.write "<card title=""出错""><p>"
  end if
   Response.write "密码不对"
   Response.write "<br/><anchor><prev/>返回</anchor>"
call head1()
   Response.end
end if
end if 
end if 


if Instr(","&Disallow&",",","&myid&",") > 0 then
   conn.close
   set conn=Nothing
if saytk<>1 then
Response.write "<title>错误</title></head><body><body bgcolor="""&yanse12&"""><p>"
else
   Response.write "<card title=""出错""><p>"
end if
   Response.write "您被禁止进入此聊天室."
   Response.write "<br/><anchor><prev/>返回</anchor>"
call head1()
   Response.end
end if

if roomadmin2<>0  and keys<>1 and keys<>2 and mmtext<>"" then

if Instr(","&mmtext&",",","&myid&",") <= 0 then
   conn.close
   set conn=Nothing


   Response.write "此聊天室已加密.请输入密码进入<br/>"
   if request("chatmm")<>"" then
      Response.write "请再输入一次密码<br/>"
   end if
   response.write"密码<br/>"
if saytk<>1 then
Response.write "<form name=""form"" method=""post"" action=""chatroom.asp?ID="&ID&"&amp;sid="&sid&"&amp;saytk="&saytk&""">"
end if
response.write"<input name='chatmm' value=''/><br/>"
if saytk<>1 then
response.write "<input type=""submit"" name=""Submit"" value=""确定进入""></form><br/>"
else
response.write"<anchor>确定进入<go href='chatroom.asp?ID="&ID&"&amp;sid="&sid&"&amp;saytk="&saytk&"' method='post' accept-charset='utf-8'>"
response.write"<postfield name='chatmm' value='$(chatmm)'/>"
response.write"</go></anchor><br/>"

   Response.write "<br/><anchor><prev/>返回</anchor>"
end if
call head1()
   Response.end
end if

end if



if myid<>0 then
mz="[url=uinfo.asp?id="&myid&"&amp;sid=[sid]&saytk=[saytk]]"&myni&"[/url]"
else
mz="游客"
end if
conn.execute("insert into sqdt(shijian,dz)values('"&now&"','"&mz&"去了:(url=/bbs/chat/chatroom.asp?id="& id &"&amp;sid=[sid]&saytk=[saytk])"&Chatname&"(/url)')")














'检查有几条新留言
dim newguest
newguest = 0
IF myid > 0 THEN
  newguest = ForNewGuest(myid)
END IF
if newguest > 0 then
Response.write "<a href='../msgview.asp?sid="&sid&"&amp;saytk="&saytk&"'>您有"&newguest&"条新消息</a><br/>"& chr(13)
end if
'更新页面
if ChatID <> ID then
  conn.execute("update Users Set ChatID ="&ID&" where ID="&myid)

  '更新在线人数
  dim reBeon
  If datesql=0 then
  set rs=server.CreateObject("ADODB.RecordSet")
  rs.Open "select ID from Users where tjj >= '"&DateAdd("n", chatonline, Now())&"' and ChatID = "&ID&" order by tjj desc",conn,1,1
  reBeon= rs.RecordCount
  rs.close
  set rs=Nothing
  Else
reBeon=conn.execute("Select count(ID) from users where ChatID = "&ID&"")(0)
End if
  if reBeon <> cBeon then
   conn.execute("update Chat Set Chatnum = "&reBeon&" where ID="&ID)
   cBeon = reBeon
  end if
end if


if Title<>"" then Response.write UBB(Title)&"<br/>"&chr(13)
Response.write "<a href=""chatsend.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">发言</a> "&chr(13)

Response.write " <a href=""invite.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">邀请</a>"&chr(13)

Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;t="&left(int(timer()),4)&"&amp;saytk="&saytk&""">刷新</a>"&chr(13)

Response.write "<a href=""exit.asp?sid="&sid&"&amp;saytk="&saytk&""">离开</a>"&chr(13)

Response.write "<a href=""chatonline.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">在线("&cBeon&")</a><br/>"&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))&"<br/>"&chr(13)
      n=n+1
      loop
    else
      Response.write "1."&chatusb(Chat)&"<br/>"&chr(13)
    end if
  end if
if saytk=>2 then
Response.write "<form name=""form"" method=""post"" action=""chatsendok.asp?sid="&sid&"&amp;saytk="&saytk&""">"
Response.write "<input type=""text"" emptyok=""true"" name=""Chat""/>"&chr(13)
response.write "<input type=""hidden"" name=""ID"" value="""&ID&"""/>"
response.write "<input type=""hidden"" name=""TM"" value="""&TM&"""/>"
response.write "<input type=""hidden"" name=""Pa"" value="""&Pa&"""/>"
response.write "<input type=""submit"" name=""Submit"" value=""快速发言""></form><br/>"
else
Response.write "<input type=""text"" emptyok=""true"" name=""Chat"&left(suijie,4)&"""/>"&chr(13)
Response.write "<br/><anchor>快速发言"&chr(13)
Response.write "<go href=""chatsendok.asp?sid="&sid&"&amp;saytk="&saytk&""" method=""post"">"&chr(13)
Response.write "<postfield name=""ID""   value="""&ID&"""/>"&chr(13)
Response.write "<postfield name=""Chat"" value=""$(Chat)""/>"&chr(13)
Response.write "<postfield name=""TM""   value="""&TM&"""/>"&chr(13)
Response.write "<postfield name=""Pa"" value="""&Pa&"""/>"&chr(13)
Response.write "</go></anchor>"
Response.write "<br/>"&chr(13)
end if
  if page < maxvp then
  Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;page="&page+1&"&amp;TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">下一页</a> "&chr(13)
  end if
  if page >1 then
  Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;page="&page-1&"&amp;TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">上一页</a>"&chr(13)
  end if

  Response.write "<br/>刷新:<a href=""chatroom.asp?ID="&ID&"&amp;TM=0&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">手动</a> "
  Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;TM=10&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">10</a> "
  Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;TM=30&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">30</a> "
  Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;TM=50&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&""">50</a>秒"
  
  Response.write "<br/>页面:<a href=""chatroom.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa=10&amp;sid="&sid&"&amp;saytk="&saytk&""">10</a> "
  Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa=15&amp;sid="&sid&"&amp;saytk="&saytk&""">15</a> "
  Response.write "<a href=""chatroom.asp?ID="&ID&"&amp;TM="&TM&"&amp;Pa=20&amp;sid="&sid&"&amp;saytk="&saytk&""">20</a>条/页"



if myid = AdminID or keys = 1 or keys=2 or clng(gruid)=adminzone then
Response.write "<br/><a href=""chatadmin.asp?ID="&ID&"&amp;sid="&sid&"&amp;saytk="&saytk&""">管理聊天室</a>"&chr(13)
end if


Response.write "<br/>管理员:"
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 "<a href=""../uinfo.asp?ID="&ChatAdmins(c)&"&amp;sid="&sid&"&amp;saytk="&saytk&""">"&username&"</a>"&chr(13)

  next
end if
conn.close
set conn=Nothing

Response.write "<br/>--------------<br/><a href=""../show.asp?sid="&sid&"&amp;saytk="&saytk&""">地盘</a>&gt;&gt;"
if gruid<>0 then
Response.write "<a href=""../board.asp?bbsid="&gruid&"&amp;sid="&sid&"&amp;saytk="&saytk&""">群组</a>&gt;&gt;"
else
Response.write "<a href=""index.asp?sid="&sid&"&amp;saytk="&saytk&""">大厅</a>&gt;&gt;"
end if
Response.write "<a href=""/bbs/index.asp?sid="&sid&"&amp;saytk="&saytk&""">社区</a><br/>(c) "&Request.ServerVariables("SERVER_NAME")&"["&String(2-Len(hour(now)),"0") & hour(now) &":"&String(2-len(minute(now)),"0") & minute(now)&"]"
call headsay()
%>

<%

function chatusb(str)
	str=trim(str)
	if IsNull(str) then exit function
	str = replace(str, "sid=@@sid@@", "TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"&amp;saytk="&saytk&"")
Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	re.pattern="(\(img)\)(.{5,}?)\(/img\)"
	str= re.Replace(str,"<img src=""$2"" alt='.'/>")
	re.pattern="(\[img\])(.[^\[]*)(\[\/img\])"
	str= re.Replace(str,"<img src=""$2"" alt='.'/>")
	re.pattern="(\(URL\))(.[^\(]*)(\(\/URL\))"
	str= re.Replace(str,"<a href=""$2"" >$2</a>")
	re.pattern="(\(URL=(.[^\(]*)\))(.[^\(]*)(\(\/URL\))"
	str= re.Replace(str,"<a href=""$2"" >$3</a>")
	re.pattern="(\[url\])(.[^\[]*)(\[\/url\])"
	str= re.Replace(str,"<a href=""$2"" >$2</a>")
	re.pattern="(\[url=(.[^\]]*)\])(.[^\[]*)(\[\/url\])"
	str= re.Replace(str,"<a href=""$2"" >$3</a>")
	re.pattern="(\(c\))(.[^\[]*)(\(\/c\))"
	str= re.Replace(str,"<a href=""wtai://wp/mc;$2"" >$2</a>")
	re.pattern="(\(c=(.[^\]]*)\))(.[^\[]*)(\(\/c\))"
	str= re.Replace(str,"<a href=""wtai://wp/mc;$2"" >$3</a>")
	re.pattern="(\(u\))(.[^\[]*)(\(\/u\))"
	str= re.Replace(str,"<u>$2</u>")
	re.pattern="(\(b\))(.[^\[]*)(\(\/b\))"
	str= re.Replace(str,"<b>$2</b>")
	re.pattern="(\(i\))(.[^\[]*)(\(\/i\))"
	str= re.Replace(str,"<i>$2</i>")
        re.Pattern="(\\\\)"
	str= re.Replace(str,"<br/>")
	set re=nothing
	chatusb=str
end function
%>
     