<!-- #include file="connadmin.asp" -->
<!-- #include file="cls.asp" -->
<%
'判断奇偶数
function Is_odd(num)
n=num mod 2
if n=1 then
Is_odd=true
else
Is_odd=false
end if
end function
Function xlanlj(dz)
if saytk>1 then
Response.write"<form action="""&dz&""" method=""POST"" name=""form1"">"
end if
end Function
Function xlanlj1(mc)
%>
<input type="submit" name="Submit" value="<%=mc%>"></form><br/>
<%
end Function
Function xltjlj(nm,va)
response.write "<input type=""hidden"" name="""&nm&""" value="""&va&"""/>"
end Function
function xlurl(lj,mc)
%><a href="<%=lj%>"><%=mc%></a><%
end function
'==========主站配置信息定义=========
dim listnums,viewtnums,softnum,smallsoftnum,softviewnum,picnum,smallpicnum,picviewnum,smallimages,wjop


if instr(Request.ServerVariables("HTTP_CONTENT_TYPE"),"multipart/form-data")=0 then
YD_Inf = split(YD_In,"|")
'--------POST部份------------------
If Request.Form<>"" Then
For Each YD_Post In Request.Form

For YD_Xh=0 To Ubound(YD_Inf)
If Instr(LCase(Request.Form(YD_Post)),YD_Inf(YD_Xh))<>0 Then
Response.clear
call head()
Call saycardd("提示")
Response.Write "您好.您输入了系统限制的内容!<br/>可能是文本里有限制字符!请返回删除限制字符.<br/>提交参数："&YD_Post&"出错，请返回<br/>" & vbnewline
if saytk=1 then
Response.write "<anchor><prev/>返回上级</anchor>" & chr(13)
end if
call head3()
Response.End
End If
Next

Next
End If
'----------------------------------

'--------GET部份-------------------
If Request.QueryString<>"" Then
For Each YD_Get In Request.QueryString

For YD_Xh=0 To Ubound(YD_Inf)
If Instr(LCase(Request.QueryString(YD_Get)),YD_Inf(YD_Xh))<>0 Then
Response.clear
call head()
Call saycardd("提示")

Response.Write "您好.本站启用了sql防注入系统！<br/>可能是文本里有限制字符!请返回删除限制字符.<br/>提交参数："&YD_Post&"出错，请返回<br/>" & vbnewline
Response.write "<anchor><prev/>返回上级</anchor>" & chr(13)
call head1()
Response.End
End If
Next
Next
End If
End If
'IP地址
dim PassIP
PassIP = Request.ServerVariables("REMOTE_ADDR")
PassIP = left(PassIP,5)

'================================================

'函数名：ForNewGuest
'作  用：新消息条数的函数
'参  数：strmid 会员ID
'================================================
Function ForNewGuest(strmid)
  dim rsguest
  Set rsguest = Server.CreateObject("ADODB.Recordset")
  rsguest.open "SELECT ID From Guest where sid="&strmid&" and fzt = 0",conn,1,1
  ForNewGuest = rsguest.RecordCount
  rsguest.close
  set rsguest=nothing
End Function

'================================================
'函数名：UTF8
'作  用：字符串过滤的函数
'参  数：fname -文件路径, str_内容
'================================================
Function UTF8(Str)
	Dim i,OneStr,AllStr
	For i = 1 To Len(Str)
		OneStr = Mid(Str,i,1)
                 if asc(OneStr)=0 then
		 AllStr = AllStr & chr(38) & chr(35) & chr(120) & Hex(Ascw(OneStr)) & chr(59)
                 else 
                 AllStr = AllStr & OneStr
                  end if
	Next
	UTF8 = AllStr
End Function
function getRealPath(strPath)

  'response.write "<br>原路径:"&strPath
  dim arry,filename,newpath,creatpath
  arry=split(strPath,"/")
  filename=arry(ubound(arry))
  'response.write "<br>文件名"&filename
  if len(filename)<20 then
     getRealPath=strPath  
  else
     for i=0 to len(filename)
         if i=4 or i=6 or i=8 then
         newpath= newpath & "/" & Mid(filename,i+1,1)
         else
         newpath= newpath & Mid(filename,i+1,1)
         end if

     next
   
  'response.write "<br>生成分格文件名:"&newpath

  getRealPath=Mid(strPath,1,len(strPath)-len(filename)) & newpath
  'response.write "<br>生成结果:"&newpath

  end if
end function
sub setCreateFolder(newpath)
  '创建文件夹
  dim arry2
  arry2=split(newpath,"/")
  creatpath= Mid(newpath,1,len(newpath)-len(arry2(ubound(arry2))))
  	 	dim fsok	
	 	Set fsok = Server.CreateObject("Scripting.FileSystemObject")

     dim arry3,temppath,cp
     arry3=split(creatpath,"/")
     'response.write "<br>生成结果23333:"&ubound(arry3)
     for m=0 to ubound(arry3)
        temppath=temppath &"\" & arry3(m)
     On Error Resume Next   
     if not fsok.folderexists(constPath & temppath) then
     	 'response.write "<br>生成结果:"&constPath & temppath
	 	      fsok.CreateFolder (constPath & temppath)	 	
	 	 end if
	 	 
	 	next	 	
	 	fsok.Close
    set fsok=nothing
'response.write "<br>生成结果22:"&constPath & temppath
   
end sub
'过滤字符写入数据库USB
function usb(str)
str=trim(str)
	if IsNull(str) then exit Function

	str=replace(str,"[标识]","saytk=[saytk]&sid=[sid]")
	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,"反革命","*")
	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,"激情图片","*")
	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,"六合彩","*")
	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,"待开发票","*")
	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,Chr(13),"\\")

	usb=str
end function

'验证英文
function ifbadchr(ZiMu,str)
dim i
ifbadchr = 0
for i=1 to len(str)
  If instr(ZiMu,mid(str,i,1))=0 then
  ifbadchr=ifbadchr + 1
  end if
next
end function
'随机广告
'统一时间
Function fordate(riqi)
if IsDate(riqi) = True then
  fordate = right(year(riqi),2) & "." & month(riqi) & "." & day(riqi) & " "
  if Hour(riqi) < 10 then
  fordate = fordate&"0"
  end if
  fordate = fordate&Hour(riqi)&":"

  if Minute(riqi) < 10 then
  fordate = fordate&"0"
  end if
  fordate = fordate&Minute(riqi)
end if
End Function
'统一时间
Function fordate2(riqi)
if IsDate(riqi) = True then
   fordate2 =""
  fordate2 = fordate2&month(riqi) & "-"
  fordate2 = fordate2&day(riqi)&" "
  fordate2 = fordate2&Hour(riqi)&":"
  if Minute(riqi) < 10 then
  fordate2 = fordate2&"0"
  end if
  fordate2 = fordate2&Minute(riqi)
end if
End Function
function adstr(adsnum)
dim rsads
set rsads = server.createobject("adodb.recordset")
rsads.open"select  id,name from gogo where typeID="&adsnum&" order by id desc ",conn,1,1
if not rsads.eof then
   dim adsranNum
   Randomize()  
adsranNum = int(rsads.recordCount*rnd)+1 
rsads.absoluteposition=adsranNum
adstr=Response.Write ("<a href='url.asp?id="&ubb(rsads("id"))&"&amp;sid="&sid&"'>"&ubb(rsads("name"))&"</a>")
end if
     rsads.close
set rsads=nothing
end function
'内容UBB2
function ubb2(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,"'","&apos;")
	str=replace(str,"""","&quot;")
	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,"台独","*")
	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,"成人电影","*")
	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,"窃听器","*")
	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,"待开发票","*")
	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,"[nn]", ""&year(now)&"")
        str=replace(str,"[yy]", ""&Month(now)&"")
        str=replace(str,"[rr]", ""&Day(now)&"")
        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, "saytk=[saytk]", "saytk="&saytk&"")
        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="(\(img)\)(.{5,}?)\(/img\)"
str= re.Replace(str,"<img src="""&Replace("$2","[sid]","")&""" alt='.'/>")
re.pattern="(\[img\])(.[^\[]*)(\[\/img\])"
str= re.Replace(str,"<img src="""&Replace("$2","[sid]","")&""" alt='.'/>")
	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/>")

	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<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
	set re=Nothing
	ubb2=str

end function



'==============================
Function adsetkf(adnum)
dim rsadset,adset1,adset2,adset3,adset4,adset5
set rsadset=server.CreateObject("adodb.recordset")
rsadset.open"select "&adnum&" from twapp where ID=1",conn,1,1
if not rsadset.eof then
adsetkf=rsadset(adnum)
end if
rsadset.close
set rsadset=nothing
end function
'MwBnAHg= Lcase(Request.ServerVariables("SERVER_NAME"))
'IF InStrRev(MwBnAHg,deCode_base64("NAB4AG4AZQB3AC4AYwBuAA==")) <= 0 and InStrRev(MwBnAHg,deCode_base64("YgBnAHkAdAB0ADEAMAAuAHcANAA0AC4AMAA4AGgAbwBzAHQALgBjAG8AbQA=")) <= 0 THEN
'response.redirect "/"
'end if

Function R_url()
dim WAPurl
WAPurl=WAPurl&request.ServerVariables("SCRIPT_NAME") 
'WAPurl=WAPurl&"http://"&request.ServerVariables("Server_NAME")&request.ServerVariables("SCRIPT_NAME") 
if(len(trim(request.ServerVariables("QUERY_STRING")))>0) then 
WAPurl=WAPurl & "?" & request.ServerVariables("QUERY_STRING")
WAPurl=replace(WAPurl,"&","@@")
end if 
R_url=WAPurl
End Function



sub Error(erstr)
  conn.close
  set conn=Nothing
  Response.write erstr & chr(13)

if saytk>1 then 

Response.write "<form name=""form"" method=""post"" action=""index.asp?saytk="&saytk&"&amp;sid="&sid&""">"
response.write "<br/><input type=""submit"" name=""submit"" value=""返回""/></form>"

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

function Errorsay(erstr,say)
  conn.close
  set conn=Nothing
  Response.write erstr & chr(13)
if saytk>1 then 
Response.write "<form name=""form"" method=""post"" action="""&say&""">"
response.write "<br/><input type=""submit"" name=""submit"" value=""返回上级""/></form>"
 Call head1()
  Response.end
else
  Response.write "<br/><anchor><prev/>返回上级</anchor>" & chr(13)
  Response.write "</p></card></wml>"
  Response.end
end if
end function


dim t1,tt
t1=timer()
tt=int(t1)

function xkme_chatusb(str)
	str=trim(str)
	if IsNull(str) then exit function
	str = replace(str, "sid=@@sid@@", "TM="&TM&"&amp;Pa="&Pa&"&amp;sid="&sid&"")
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
	xkme_chatusb=str
end Function

%>

<!-- #include file="Utf8.asp" -->
<!-- #include file="YD_Counter.asp" -->
