<% Response.ContentType = "text/vnd.wap.wml" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" sub Error(erstr) conn.close set conn=Nothing Response.write erstr & chr(13) Response.write "
返回" & chr(13) Response.write "

" Response.end 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("

你已被禁止使用信箱功能！") 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("

你已被禁止使用聊天室！") 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,"&","←↑→") 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," ","") str=replace(str,"","") str=replace(str,"","") str=replace(str,"$","$$") str=replace(str,"￥","*") str=replace(str," ","") str=replace(str,"(br)","
") str=replace(str,"[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,"(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="(\(img)\)(.{5,}?)\(/img\)" str= re.Replace(str,"img") re.pattern="(\[img\])(.[^\[]*)(\[\/img\])" str= re.Replace(str,"img") 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,"
") if instr(1,str,"(/re)",1)>0 then re.Pattern="(^.*)(\(re\))(.+?)(\(\/re\))(.*)" if myid=rs("fid") or skey=rs("bbsid") or keys=1 then str=re.Replace(str,"$1$3$5") else if isNull(myid) or myid="" or tid="" then strContent= re.Replace(str,"$1
[隐藏内容回复后才能浏览]
$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
[隐藏内容回复后才能浏览]
$5") end if end if end if '付费可见 if instr(1,str,"(/buy)",1)>0 then re.Pattern="(^.*)(\(buy=*([0-9]*)\))(.+?)(\(\/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
[请先登陆后才能购买并浏览]
$6") elseif Clng(myjb)< Clng(payCents) then str= re.Replace(str,"$1
[抱歉您的"&getcent&"不足$3不能购买并浏览]
$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&"&bbsid="&bbsid&"&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&"&bbsid="&bbsid&"&sid=@@sid@@]]"&tidname&"[/url]',"&fid&",0)") str=re.Replace(str,"$1$4$6") else str=re.Replace(str,"请不要重复购买！
$1$4$6") end if end if end if if Instr(","&rs("payID")&",",","&myid&",") > 0 or keys=1 or skey=abs(bbsid) 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
[此处内容需要"&getcent&"$3购买才可以浏览，我要购买]
$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 if newvipdj<>0 then Response.write ".." elseif clng(getvip(newmyjb+newbank,newmyjy))>0 then Response.write ".." end if end function dim tss tss=timer() %>