<!-- #include file="../Inc/Inc.asp" -->

<%
'取用户名
'==================================
Function unames(usersid)
if usersid="" or isnumeric(usersid)=False then usersid=0
set rsusername=server.CreateObject("ADODB.RecordSet")
rsusername.Open "select name from Users where ID="&usersid,conn,1,1
usersnamee=rsusername("name")
rsusername.close
Set rsusername=nothing
If usersid=0 Then
response.write"无此会员!"
else
response.write""&usersnamee&""
End if
end Function


'==================================
sub Error(erstr)
  conn.close
  set conn=Nothing

  Response.write erstr & chr(13)
  response.Write"<br/>前往:<a href=""/index.asp?sid="&sid&"&amp;saytk="&saytk&""">首页</a>|<a href=""/bbs/index.asp?sid="&sid&"&amp;saytk="&saytk&""">社区</a>|<a href=""/bbs/show.asp?sid="&sid&"&amp;saytk="&saytk&""">小屋</a>"
  if saytk<>1 Then
  Response.write "<form name=""form"" method=""post"" action=""index.asp?sid="&sid&"&amp;saytk="&saytk&""">"
end if
  if saytk<>1 then 
response.write "<input type=""submit"" name=""submit"" value=""返回""/></form><br/>"

  Response.write "</p></body></html>"
  Response.end
else
  Response.write "<br/><anchor><prev/>返回</anchor>" & chr(13)
  Response.write "</p></card></wml>"
  Response.end
end if

end sub

'英文检查
function Ifhttp(str)
dim ht
Ifhttp = 0
for ht=1 to len(str)
  If instr("(=)0123456789",mid(str,ht,1)) = 0 then
  Ifhttp = Ifhttp + 1
  end if
next
end function
function format(txt)
if txt="nof" then
format="禁止发表帖子"
elseif txt="f" then
format="允许发表帖子"

elseif txt="noh" then
format="禁止回复帖子"
elseif txt="h" then
format="允许回复帖子"

elseif txt="nox" then
format="禁止使用信箱"
elseif txt="x" then
format="允许使用信箱"

elseif txt="nol" then
format="禁止使用聊天室"
elseif txt="l" then
format="允许使用聊天室"

elseif txt="noj" then
format="加黑用户"
elseif txt="j" then
format="解黑用户"

elseif txt="lock" then
format="全区加黑用户"
elseif txt="nolock" then
format="全区解黑用户"

else
format=txt
end if
end function
Sub Fortxtmsg
set rs=server.createobject("adodb.recordset")
rs.open "select strmsg from hmd where guliid="&myid,conn,1,1
if not rs.eof then
if rs("strmsg")>0 then
 Call Error("<card title=""出错""><p>你已被禁止使用信箱功能！")
  end if
end if
rs.close
set rs=nothing
end Sub
Sub FortxtChat
set rs=server.createobject("adodb.recordset")
rs.open "select strChat from hmd where guliid="&myid,conn,1,1
if not rs.eof then
if rs("strChat")>0 then
 Call Error("<card title=""出错""><p>你已被禁止使用聊天室！")
  end if
end if
rs.close
set rs=nothing
end Sub
'骂人
function maren(matxt)
dim Abuse,AbAry
Abuse = matxt
maren = 0
if Abuse <> "" then
  Abuse = replace(Abuse,"日死你","|**\")
  Abuse = replace(Abuse,"我操你","|**\")
  Abuse = replace(Abuse,"干死你","|**\")
  Abuse = replace(Abuse,"鸡巴","|**\")
  Abuse = replace(Abuse,"操逼","|**\")
  Abuse = replace(Abuse,"贱逼","|**\")
  Abuse = replace(Abuse,"干你娘","|**\")
  Abuse = replace(Abuse,"卖逼","|**\")
  Abuse = replace(Abuse,"烂逼","|**\")
  Abuse = replace(Abuse,"靠你妈","|**\")
  Abuse = replace(Abuse,"操你妈","|**\")
  Abuse = replace(Abuse,"逼样","|**\")
  Abuse = replace(Abuse,"操你","|**\")
  Abuse = replace(Abuse,"婊子","|**\")
  Abuse = replace(Abuse,"我日","|**\")
  Abuse = replace(Abuse,"我操","|**\")
  Abuse = replace(Abuse,"日你","|**\")
  Abuse = replace(Abuse,"操他","|**\")
  Abuse = replace(Abuse,"操蛋","|**\")
  Abuse = replace(Abuse,"屄","|**\")
  Abuse = replace(Abuse,"群奸","|**\")
  Abuse = replace(Abuse,"贱人","|**\")
  Abuse = replace(Abuse,"狗娘","|**\")
  Abuse = replace(Abuse,"奶子","|**\")
  Abuse = replace(Abuse,"打炮","|**\")
  Abuse = replace(Abuse,"龟公","|**\")
  Abuse = replace(Abuse,"屁眼","|**\")
  Abuse = replace(Abuse,"去你妈的","|**\")
  Abuse = replace(Abuse,"肛门","|**\")
  Abuse = replace(Abuse,"阴茎","|**\")
  Abuse = replace(Abuse,"淫穴","|**\")
  Abuse = replace(Abuse,"狗卵子","|**\")
  Abuse = replace(Abuse,"狗操","|**\")
  Abuse = replace(Abuse,"阴道","|**\")
  Abuse = replace(Abuse,"阴水","|**\")
  Abuse = replace(Abuse,"阴唇","|**\")
  Abuse = replace(Abuse,"阴蒂","|**\")
  Abuse = replace(Abuse,"狂操","|**\")
  Abuse = replace(Abuse,"杂种","|**\")
  Abuse = replace(Abuse,"插你","|**\")
  Abuse = replace(Abuse,"肛交","|**\")
  Abuse = replace(Abuse,"狗东西","|**\")
  Abuse = replace(Abuse,"操操操","|**\")
  Abuse = replace(Abuse,"傻逼","|**\")

  AbAry = Split(Abuse,"|**\")
  maren = ubound(AbAry)
end if
end function
'---------------------------------------
'内容UBB3
function ubb3(str)
	if IsNull(str) then exit function
	str=trim(str)
	str=replace(str,"[标识]","saytk=[saytk]&sid=[sid]")
	str=replace(str,"&amp;","←↑→")
	str=replace(str,"&","&amp;")
	str=replace(str,"←↑→","&amp;")
	str=replace(str,"<","&lt;")
	str=replace(str,">","&gt;")
	str=replace(str,"'","“")
    str = replace(str, "", "")
    str = replace(str, "", "")
	str=replace(str,"","")
	str=replace(str," ","")
	str=replace(str,"","")
	str=replace(str,"","")
	str=replace(str,"$","$$")
        str=replace(str,"&#xFFE5;","*")
	str=replace(str,"&nbsp;","")
	str=replace(str,"(br)","<br/>")
	str=replace(str,"[br]","<br/>")
	str=replace(str,"[tid]",""&tid&"")
	str=replace(str,"[date]",""&date&"")
	str=replace(str,"[time]",""&time&"")
	str=replace(str,"(name)",""&myni&"")
	str=replace(str,"(myid)",""&myid&"")
        str=replace(str,"(time)",""&time()&"")
        str=replace(str,"(date)",""&date()&"")
	str = replace(str, "sid=@@sid@@", "sid="&sid&"")
	str = replace(str, "sid=sid", "sid="&sid&"")
	str = replace(str, "sid=[sid]", "sid="&sid&"")
	str = replace(str, "saytk=@@saytk@@", "saytk="&saytk&"")
	str = replace(str, "saytk=saytk", "saytk="&saytk&"")
	str = replace(str, "saytk=[saytk]", "saytk="&saytk&"")
	str = replace(str, "(buy)", "(bbuy)")
        str=replace(str,"(now)",""&now()&"")
        str=replace(str,"(week)",""&WeekDayName(DatePart("w",Now))&"")
        str=replace(str,Chr(13),"\\")
        str=replace(str,Chr(14),"\\")
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	re.pattern="(\(cz2.0=(.[^\}]*)\))(.[^\}]*)(\(\/cz2.0\))"
    if saytk>1 And saytk<>5 then
    str= re.Replace(str,"<div style=""color:#$2;display:inline;"">$3</div>")
    else
    str= re.Replace(str,"$3")
    end If

    re.pattern="(\(div=(.[^\}]*)\))(.[^\}]*)(\(\/div\))"
    if saytk>1 And saytk<>5 then
    str= re.Replace(str,"<div style=""$2"">$3</div>")
    else
    str= re.Replace(str,"$3")
    end If
    
	re.pattern="(\(img)\)(.{5,}?)\(/img\)"
	str= re.Replace(str,"<img src=""$2"" alt='img'/>")
	re.pattern="(\[img\])(.[^\[]*)(\[\/img\])"
	str= re.Replace(str,"<img src=""$2"" alt='img'/>")
	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/>")
re.pattern="(\(d=(.[^\}]*)\))(.[^\}]*)(\(\/d\))"
if saytk=>2 then
str= re.Replace(str,"<div class=""$2"" >$3</div>")
else
str= re.Replace(str,"$3")
end if
	if instr(1,str,"(/re)",1)>0 then	
		re.Pattern="(^.*)(\(re\))(.[^\}]*)(\(\/re\))(.*)"
           if myid=rs("fid") or skey=rs("bbsid") or keys=1 or keys=2 then
		  str=re.Replace(str,"$1$3$5")	
              else
		if isNull(myid) or myid="" or tid="" then
			strContent= re.Replace(str,"$1<br/>[隐藏内容回复后才能浏览]<br/>$5")
		elseif Not(conn.execute("select top 1 id from relist where fid="&myid&" and tid="&tid).eof) then		
		  str=re.Replace(str,"$1$3$5")	
	
	  else
		  str= re.Replace(str,"$1<br/>[隐藏内容回复后才能浏览]<br/>$5")
	  end if
	end if
	  end if
	  
	  '付费可见
	if instr(1,str,"(/buy)",1)>0 then	
		re.Pattern="(^.*)(\(buy=(.[^\}]*)\))(.[^\}]*)(\(\/buy\))(.*)"	
		dim payCents,rmb
		payCents=re.Replace(str,"$3")
		payCents=replace(payCents,"-","")
		if payCents="" or isNumeric(payCents)=False then payCents=0
		if CLng(payCents)>10000 then payCents=10000 end if
		if not IsNumeric(payCents) then payCents=0 end if
		rmb=request("rmb")
		if rmb="ok" then
		
		if myid=0 then
		    str= re.Replace(str,"$1<br/>[请先<a href=""login.asp?url="&Replace(Replace(R_url(),"sid=","sidoo="),"sid=","sidoo=")&""">登陆</a>后才能购买并浏览]<br/>$6")
			elseif Clng(myjb)< Clng(payCents) then
				 str= re.Replace(str,"$1<br/>[抱歉您的"&getcent&"不足<b>$3</b>不能购买并浏览]<br/>$6")
			else

		set rsbuy=server.CreateObject("ADODB.RecordSet")
rsbuy.Open "SELECT ID,paycent,payID,fid  FROM sell WHERE yc=0 AND  ID="&tid,conn,1,2
if Instr(","&rsbuy("payID")&",",","&myid&",") = 0 then
  if rsbuy("payID") <> "" then
   rsbuy("payID") = rsbuy("payID")&","&myid
  else
   rsbuy("payID") = myid
  end if
  rsbuy.update
conn.execute("update [users] set myjb=myjb-"&payCents&" where id="&myid)   
conn.execute("update [users] set myjb=myjb+"&payCents&" where id="&fid)					   
				    conn.execute("insert into guest(fnr,sid,fid)values('您购买了论坛内容扣除:"&payCents&"个"&getcent&",购买时间："&now()&"[br]论坛主题:[url=/bbs/topic.asp?tid="&tid&"&amp;bbsid="&bbsid&"&amp;sid=@@sid@@]"&tidname&"[/url]',"&myid&",0)")
				    conn.execute("insert into guest(fnr,sid,fid)values('恭喜,"&myni&"购买了您的论坛内容，赚回:"&payCents&"个"&getcent&",购买时间："&now()&"[br]论坛主题:[url=/bbs/topic.asp?tid="&tid&"&amp;bbsid="&bbsid&"&amp;sid=@@sid@@]]"&tidname&"[/url]',"&fid&",0)")	 
			str=re.Replace(str,"$1$4$6")
else
str=re.Replace(str,"请不要重复购买！<br/>$1$4$6")
end if
end if
end if
		if Instr(","&rs("payID")&",",","&myid&",") > 0 or keys=1 or skey=abs(bbsid) or keys=2 then
					str=re.Replace(str,"$1$4$6")
		elseif fid<>"" and fid=myid then
			str=re.Replace(str,"$1$4$6")
		else	
		
				str= re.Replace(str,"$1<br/>[此处内容需要"&getcent&"<b>$3</b>购买才可以浏览，<a href=""topic.asp?tid="&tid&"&amp;bbsid="&bbsid&"&amp;rmb=ok&amp;sid="&sid&""">我要购买</a>]<br/>$6")
end if
	end if	
		
	set re=Nothing
	ubb3=str
end function
function vipshow(showid)
if showid="" or isnumeric(showid)=False then showid=0
set rsvip=server.CreateObject("ADODB.RecordSet")
rsvip.Open "select myjy,myjb,vipdj,bank from Users where ID="&showid,conn,1,1
newmyjb=rsvip("myjb")
newbank=rsvip("bank")
newmyjy=rsvip("myjy")
newvipdj=rsvip("vipdj")
rsvip.close
set rsvip=Nothing
   Dim viplogo11
   If newvipdj=1 Then
   viplogo11=viplogo1
   ElseIf newvipdj=2 Then
   viplogo11=viplogo2
   ElseIf newvipdj=3 Then
   viplogo11=viplogo3
   ElseIf newvipdj=4 Then
   viplogo11=viplogo4
   ElseIf newvipdj=5 Then
   viplogo11=viplogo5
   End if
   if newvipdj<>0 Then

   Response.write "<img src="""&viplogo&""" alt='.'/><img src="""&viplogo11&""" alt='.'/>"
   
   end if
end function
dim tss
tss=timer()

%>