<%
'****************************************************
' 儒洞中学管理系统 Power by zws212
' Web: http://yxrd.edu.gdbnet.cn/
' Copyright (C) 2010-2011 zws212 All Rights Reserved.
'****************************************************
Function Mydb(MySqlstr,MyDBType)
	Select Case MyDBType
	Case 0 : Conn.Execute(MySqlstr) : Dataquery = Dataquery + 1
	Case 1 : Set Mydb = Conn.Execute(MySqlstr) : Dataquery = Dataquery + 1
	Case 2 : Set Mydb = Server.CreateObject("Adodb.Recordset") : Mydb.Open MySqlstr,Conn,1,1 : Dataquery = Dataquery + 1
	case 3:
		set db = server.createobject("Adodb.Recordset")
		db.open sqlstr, conn, 1, 3
	End Select
End Function
	
Function CheckStr(str) 
	CheckStr=replace(replace(replace(replace(str,"<","&lt;"),">","&gt;"),chr(13),"")," ","") 
	CheckStr=replace(replace(replace(replace(CheckStr,"'",""),"and",""),"insert",""),"set","") 
	CheckStr=replace(replace(replace(replace(CheckStr,"select",""),"update",""),"delete",""),chr(34),"")
	CheckStr=replace(replace(replace(replace(CheckStr,"*",""),"=",""),"mid",""),"count","")
	CheckStr=replace(replace(replace(replace(CheckStr,"%",""),",",""),"union",""),"where","")
	CheckStr=replace(replace(replace(replace(replace(CheckStr,"(",""),")",""),Chr(0),""),"+",""),";","")
end Function

Function LaoYRequest(ParaName)
     Dim ParaValue
     ParaValue = trim(ParaName)
	 If ParaValue="" Then Exit Function
        If Not isNumeric(ParaValue) Then
		    Response.Write "<li>  参数类型不合法"
			Response.end
	    Else
           LaoYRequest = ParaValue
        End If
End Function

Function GetIP() 
	Dim strIPAddr 
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" Or InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
		strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then 
		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
	Else 
		strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
	End If 
	getIP = Checkstr(Trim(Mid(strIPAddr, 1, 30)))
	If getIP="" then getIP="127.0.0.1"
End Function

Function ShowLabel(id)
	if id = "" or isnull(id) then
		ShowLabel = 0
	else
		Sqld = "Select Content from "&tbname&"_Label where ID = " & id
		Set rsd = conn.execute(Sqld)
		if not rsd.eof then
			ShowLabel = rsd(0)
		else
			ShowLabel = ""
		end if
		rsd.close
	end if
End function

Function LoseHtml(ContentStr)
 Dim ClsTempLoseStr,regEx
	ClsTempLoseStr = Cstr(ContentStr)
	Set regEx = New RegExp
	regEx.Pattern = "<(.[^>]*)>"
	regEx.IgnoreCase = True
	regEx.Global = True
	ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
	RegEx.Pattern = "(&.+?;)"
	ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr, "")
	ClsTempLoseStr = Replace(ClsTempLoseStr,VbCrlf,"")
	ClsTempLoseStr = Replace(ClsTempLoseStr,VbCr,"")
	ClsTempLoseStr = Replace(ClsTempLoseStr,VbLf,"")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"  ","")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"","")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"""","'")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"[code]","")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"<!--","")
	ClsTempLoseStr = Trim(ClsTempLoseStr)
 LoseHtml = ClsTempLoseStr
End Function

Function dvHTMLEncode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")

    fString = Replace(fString, CHR(32), "&nbsp;")
    fString = Replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")
    'fString = Replace(fString, "http://static3.photo.sina.com.cn", "photo.asp?url=http://static3.photo.sina.com.cn")

    dvHTMLEncode = fString
end if
end Function

Function HasChinese(str) 
HasChinese = false 
dim i 
for i=1 to Len(str) 
if Asc(Mid(str,i,1)) < 0 then 
HasChinese = true 
exit for 
end if 
next 
end Function

Function replacecolor(Str)
	Dim re,s
	S=Str
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="("& KeyWord &")"
	s=re.Replace(s,"<font color='red'>"& KeyWord &"</font>")
	Set Re=Nothing
	replacecolor=s
End Function

Function iparray(ipstr)
 dim t,ipx,ipfb
 if not isnull(ipstr) then
        t = 0
 ipx=""
 ipfb = split(ipstr, ".",4)
  for t = 0 to 2
  ipx = ipx&ipfb(t)&"."
  next
 iparray = ipx&"*"
 end if
end Function

'判断数字奇偶
Function isEven(num)
if not isNumeric(num) then
isEven="这不是一个数字啊"
exit Function
end if
if num mod 2 = 0 then
isEven=0
else
isEven=1
end if
end Function

Function FormatDate(DateAndTime,para)
	On Error Resume Next
	Dim y, m, d, h, mi, s, strDateTime
	FormatDate = DateAndTime
	
	If Not IsNumeric(para) Then Exit Function
	If Not IsDate(DateAndTime) Then Exit Function
	y = Mid(CStr(Year(DateAndTime)),3)
	m = CStr(Month(DateAndTime))
	If Len(m) = 1 Then m = "0" & m
	d = CStr(Day(DateAndTime))
	If Len(d) = 1 Then d = "0" & d
	h = CStr(Hour(DateAndTime))
	If Len(h) = 1 Then h = "0" & h
	mi = CStr(Minute(DateAndTime))
	If Len(mi) = 1 Then mi = "0" & mi
	s = CStr(Second(DateAndTime))
	If Len(s) = 1 Then s = "0" & s
	
	Select Case para
		Case "1"
			strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
		Case "2"
			strDateTime = y & "-" & m & "-" & d
		Case "3"
			strDateTime = y & "/" & m & "/" & d
		Case "4"
			strDateTime = y & "年" & m & "月" & d & "日"
		Case "5"
			strDateTime = m & "-" & d
		Case "6"
			strDateTime = m & "/" & d
		Case "7"
			strDateTime = m & "月" & d & "日"
		Case "8"
			strDateTime = y & "年" & m & "月"
		Case "9"
			strDateTime = y & "-" & m
		Case "10"
			strDateTime = y & "/" & m
		Case "11"
			y = CStr(Year(DateAndTime))
			strDateTime = y & "-" & m & "-" & d
		Case "12"
			y = CStr(Year(DateAndTime))
			strDateTime = y & m & d & "_" & h & mi & s			
		Case Else
			strDateTime = DateAndTime
		End Select
		
	'FormatDate = strDateTime
	If datediff("d",DateAndTime,Now())=0 then
	FormatDate = "<font color=#ff0000>"&strDateTime&"</font>"
	else
	FormatDate = ""&strDateTime&""
	End if
End Function

'=================================================
'过程名：BbbImg
'作  用：鼠标滚轮控制图片大小的函数
'参  数：strText
'=================================================
Function BbbImg(strText)
         Dim s,re
         Set re=New RegExp
         re.IgnoreCase = true
         re.Global = true		 
         s=strText
		 
		'去掉图片中的脚本代码
		re.Pattern="<IMG.[^>]*SRC(=| )(.[^>]*)>"
		If mouserimg=1 then
		s=re.replace(s,"<p style=""text-align:center;""><IMG SRC=$2 onload=""javascript:resizeimg(this,575,600)""></p>")
		else
		s=re.replace(s,"<p style=""text-align:center;""><IMG SRC=$2></p>")
		End if
		BbbImg = ChkBadWords(s)
	    Set re=Nothing
End Function

'脏话过滤
Function ChkBadWords(Str)
		If IsNull(Str) Then Exit Function
		On Error Resume Next
		Dim i,rBadWord,BadWord
		BadWord	= BadWord1
		BadWord = Split(BadWord,"|||")
		For i = 0 To Ubound(BadWord)
			rBadWord = Split(BadWord(i),"=")
			Str = Replace(Str,rBadWord(0),rBadWord(1))
		Next
		ChkBadWords = Str
End Function

'用户名检测
Function ChkRegName(str)
	ChkRegName = True
	On Error Resume Next
	For i=0 To Ubound(Split(userWord,","))
		If Instr(Str,Split(userWord,",")(i)) > 0 Then
			ChkRegName = False
			Exit Function
		End If
	Next
End Function

'# IIF
Function IIF(A,B,C)
	If A Then IIF = B Else IIF = C
End Function

Function laoy(block)
	if not isnull(block) then
    block = Replace(block, "{$SitePath}", SitePath)
    laoy = block
	end if
End Function

'搜索蜘蛛
Function spiderbot()
	dim agent
	agent = lcase(request.servervariables("http_user_agent"))
	dim Bot: Bot = ""
	
	'百度
	if instr(agent, "baiduspider") > 0 then Bot = "百度"
	if instr(agent, "baiducustomer") > 0 then Bot = "百度"
	if instr(agent, "baidu-thumbnail") > 0 then Bot = "百度"
	if instr(agent, "baiduspider-mobile-gate") > 0 then Bot = "百度"
	if instr(agent, "baidu-transcoder/1.0.6.0") > 0 then Bot = "百度"
	'谷歌google
	if instr(agent, "googlebot/2.1") > 0 then Bot = "谷歌"
	if instr(agent, "googlebot-image/1.0") > 0 then Bot = "谷歌"
	if instr(agent, "feedfetcher-google") > 0 then Bot = "谷歌"
	if instr(agent, "mediapartners-google") > 0 then Bot = "谷歌"
	if instr(agent, "adsbot-google") > 0 then Bot = "谷歌"
	if instr(agent, "googlebot-mobile/2.1") > 0 then Bot = "谷歌"
	if instr(agent, "googlefriendconnect/1.0") > 0 then Bot = "谷歌"
	'雅虎yahoo
	if instr(agent, "yahoo! slurp;") > 0 then Bot = "雅虎"
	if instr(agent, "yahoo! slurp/3.0") > 0 then Bot = "雅虎"
	if instr(agent, "yahoo! slurp china") > 0 then Bot = "雅虎"
	if instr(agent, "yahoofeedseeker/2.0") > 0 then Bot = "雅虎"
	if instr(agent, "yahoo-blogs") > 0 then Bot = "雅虎"
	if instr(agent, "yahoo-mmcrawler") > 0 then Bot = "雅虎"
	if instr(agent, "yahoo contentmatch crawler") > 0 then Bot = "雅虎"
	'微软bing
	if instr(agent, "msnbot/1.1") > 0 then Bot = "微软bing"
	if instr(agent, "msnbot/2.0b") > 0 then Bot = "微软bing"
	if instr(agent, "msrabot/2.0/1.0") > 0 then Bot = "微软bing"
	if instr(agent, "msnbot-media/1.0") > 0 then Bot = "微软bing"
	if instr(agent, "msnbot-products") > 0 then Bot = "微软bing"
	if instr(agent, "msnbot-academic") > 0 then Bot = "微软bing"
	if instr(agent, "msnbot-newsblogs") > 0 then Bot = "微软bing"
	'腾讯搜搜soso
	if instr(agent, "sosospider") > 0 then Bot = "腾讯搜搜"
	if instr(agent, "sosoblogspider") > 0 then Bot = "腾讯搜搜"
	if instr(agent, "sosoimagespider") > 0 then Bot = "腾讯搜搜"
	'网易有道
	if instr(agent, "youdaobot/1.0") > 0 then Bot = "网易有道"
	if instr(agent, "yodaobot-image/1.0") > 0 then Bot = "网易有道"
	if instr(agent, "yodaobot-reader/1.0") > 0 then Bot = "网易有道"
	'搜狐搜狗
	if instr(agent, "sogou web robot") > 0 then Bot = "搜狗"
	if instr(agent, "sogou web spider/3.0") > 0 then Bot = "搜狗"
	if instr(agent, "sogou web spider/4.0") > 0 then Bot = "搜狗"
	if instr(agent, "sogou head spider/3.0") > 0 then Bot = "搜狗"
	if instr(agent, "sogou-test-spider/4.0") > 0 then Bot = "搜狗"
	if instr(agent, "sogou orion spider/4.0") > 0 then Bot = "搜狗"
	'Alexa
	if instr(agent, "ia_archiver") > 0 then Bot = "Alexa"
	if instr(agent, "iaarchiver") > 0 then Bot = "Alexa"
	'奇虎
	if instr(agent, "qihoo") > 0 then Bot = "Qihoo"
	'ASK.com
	if instr(agent, "ask jeeves/teoma") > 0 then Bot = "Ask Jeeves/Teoma"
	if len(Bot) > 0 then
		set rs = server.CreateObject ("adodb.recordset")
		sql="select [Botname],[LastDate] From ["&tbname&"_Bots] Where [Botname]='" & Bot & "'"
		rs.open sql,conn,1,3
		if rs.eof and rs.bof then
		rs.AddNew 
		rs(0) = Bot
		rs(1) = now()
		else
		rs(1) = now()
		end if
		rs.update
		rs.close: set rs = nothing
	end if
end Function

Sub CreateDir(strPath)
	Dim sTmp,i,Fso,sPath
	sPath = replace(strPath,"/","\")
	sPath=Split(sPath,"\")
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	For I=0 To Ubound(sPath)
		sTmp=Replace(sTmp&sPath(I)&"\","\\","\")
		If Not Fso.FolderExists(server.Mappath(sTmp)) Then
			Fso.CreateFolder server.Mappath(sTmp)				
		End if
	Next
	Set Fso = nothing
End Sub

function createfile(byval content,byval filedir)
	on error resume next
	dim obj : set obj = server.createobject("adodb.Stream")
	obj.type = 2
	obj.open
	obj.charset = "GB2312"
	obj.position = obj.Size
	obj.writeText = content
	obj.savetofile server.mappath(filedir), 2
	obj.close
	if err then err.clear: createfile = false else createfile = true
	set obj = nothing
End function

'显示相关文章
'P_ConID:数值型，当前文章ID
'P_Key:字符型，当前文章关健字
'P_Row:数值型，要显示相关文章的条数
'P_ICO:字符型，标题前图标，可以图片也可为字符
'P_Time:数值型，显示时间，０为不显示，否则为时间格式

Function ShowMutualityArticle(P_ConID,P_Key,P_Row,P_ICO,P_Time)
    dim pRs,pSql
	dim i,TempKeyWord
	
	if P_Row > 0 then
		pSql = "Select TOP "& P_Row
	else
		pSql = "Select "
	end if
	pSql = pSql & " ID,Title,ClassId,DateAndTime From ["&tbname&"_Article] Where ID <> "& P_ConID &" And "	
	if Instr(P_Key,"|") > 0 then
		P_Key = Split(P_Key,"|")
		TempKeyWord = TempKeyWord &"("
		For i = 0 to Ubound(P_Key)
			TempKeyWord = TempKeyWord &" KeyWord like '%"& P_Key(i) &"%' or KeyWord like '%|"& P_Key(i) &"|%' or KeyWord like '%"& P_Key(i) &"|%' or KeyWord like '%|"& P_Key(i) &"%' "
			if i = Ubound(P_Key) then
				TempKeyWord = TempKeyWord &") And "
			else
				TempKeyWord = TempKeyWord &" Or "
			end if
		Next
	else
		TempKeyWord = TempKeyWord &" KeyWord like '%"& P_Key &"%' And "
	end if
	pSql = pSql & TempKeyWord &" yn = 0 Order By Id Desc"
	'Response.Write pSql
	
    Set pRs = Server.CreateObject("Adodb.recordset")
	pRs.open pSql,conn,1,3
	if not(pRs.bof and pRs.eof) then
		Do While Not pRs.eof
			if pRs(0) <> P_ConID Then
				If html=1 then
				ShowMutualityArticle = ShowMutualityArticle & "<li>"&P_ICO&"<a href="""&SitePath&"List.asp?ID="&pRs(0)&""">"&pRs(1)&"</a>"
				elseif html=2 then
				ShowMutualityArticle = ShowMutualityArticle & "<li>"&P_ICO&"<a href="""&SitePath&"Html/?"&pRs(0)&".html"">"&pRs(1)&"</a>"
				else
				ShowMutualityArticle = ShowMutualityArticle & "<li>"&P_ICO&"<a href="""&SitePath&"Html/"&pRs(0)&".html"">"&pRs(1)&"</a>"
				End if
				If P_Time>0 then
				ShowMutualityArticle = ShowMutualityArticle &"　　"&FormatDate(pRs(3),P_Time)&""
				End if
				ShowMutualityArticle = ShowMutualityArticle &"</li>" & VbCrLf
			end if
			pRs.movenext
		Loop
	else
		ShowMutualityArticle = ShowMutualityArticle & "<li>没有相关文章</li>"
	end if
	pRs.close:set pRs = nothing
End Function

'图片文章调用
'ClassID:数值型，栏目ID
'N:数值型，要显示文章条数
'T:数值型，显示时间，０为不显示，否则为时间格式
'Z:标题字数
'msql:增强条件
'P:排序方式

Sub ShowImgArticle(ClassID,N,Z,msql,P)
	set rs1=server.createobject("ADODB.Recordset")
	SQL1="select Top "&N&" ID,Title,ClassID,DateAndTime,Images,Content from "&tbname&"_Article where yn = 0 and Images<>''"
	
	If ClassID<>0 then
		If Yao_MyID(ClassID)="0" then
			SQL1=SQL1&" and ClassID="&ClassID&""
		else
			MyID = Replace(""&Yao_MyID(ClassID)&"","|",",")
			SQL1=SQL1&" and ClassID in ("&MyID&")"
		End if
	End if
	
	If msql<>"no" then
			SQL1=SQL1&" and "&msql&""
	End if
	
	SQL1=SQL1&" Order by "&P&""
	
	rs1.open sql1,conn,1,3
	If Not rs1.Eof Then 
	do while not (rs1.eof or err)
	Response.Write("<li>")
	If Html=1 then
		Response.Write("<a href="""&SitePath&"List.asp?ID="&rs1("ID")&""" target=""_blank"">")
	Elseif Html=2 then
		Response.Write("<a href="""&SitePath&"Html/?"&rs1("ID")&".html"" target=""_blank"">")
	Else
		Response.Write("<a href="""&SitePath&"Html/"&rs1("ID")&".html"" target=""_blank"">")
	end if	
    Response.Write("<img src="""&SitePath&""&SiteUp&"/")
	If IsAspJpeg=1 then
	Response.Write("s90/")
	End if
	Response.Write(""&rs1("Images")&""" title="""&rs1("Title")&""" style=""border:1px solid #ccc;padding:2px;width:90px;height:90px;""></a>")
	Response.Write("<br>")
	If Html=1 then
		Response.Write("<a href="""&SitePath&"List.asp?ID="&rs1("ID")&""" target=""_blank"">")
	elseif html=2 then
		Response.Write("<a href="""&SitePath&"Html/?"&rs1("ID")&".html"" target=""_blank"">")
	Else
		Response.Write("<a href="""&SitePath&"Html/"&rs1("ID")&".html"" target=""_blank"">")
	end if	
	Response.Write(""&left(rs1("Title"),Z)&"</a>")
	Response.Write("</li>") & VbCrLf
	rs1.movenext
	loop
	'else
	'Response.Write("<li>没有</li>")
	end if
	rs1.close
	set rs1=nothing
End Sub

'文章调用
'ClassID:数值型，栏目ID
'N:数值型，要显示文章条数
'T:数值型，显示时间，０为不显示，否则为时间格式
'ICO:字符型，标题前图标，可以图片也可为字符
'Z:标题字数
'msql:增强条件
'P:排序方式
'ClassName 数值型,1为显示栏目名称,0为不显示
'target 数值型,1为在新窗口打开

Sub ShowArticle(ClassID,N,T,ICO,Z,msql,P,ClassName,target)
	set rs1=server.createobject("ADODB.Recordset")
	SQL1="select Top "&N&" ID,Title,ClassID,DateAndTime,TitleFontColor,IsHot from "&tbname&"_Article where yn = 0"
	
	If ClassID<>0 then
		If Yao_MyID(ClassID)="0" then
			SQL1=SQL1&" and ClassID="&ClassID&""
		else
			MyID = Replace(""&Yao_MyID(ClassID)&"","|",",")
			SQL1=SQL1&" and ClassID in ("&MyID&")"
		End if
	End if
	
	If msql<>"no" then
			SQL1=SQL1&" and "&msql&""
	End if
	
	SQL1=SQL1&" Order by "&P&""
	
	rs1.open sql1,conn,1,3
	If Not rs1.Eof Then 
	do while not (rs1.eof or err)
	Response.Write("<li>")
	If T<>0 then
		Response.Write("<span style=""float:right;"">"&FormatDate(rs1(3),T)&"</span>")
	end if
	If ClassName=1 then
		If Html=3 then
			Response.Write("[<a href="""&SitePath&"Class_"&rs1(2)&".html"">"&Classlist(rs1(2))&"</a>]")
		Else
			Response.Write("[<a href="""&SitePath&"Class.asp?ID="&rs1(2)&""">"&Classlist(rs1(2))&"</a>]")
		End if
	End if
	Response.Write(""&ICO&"<a href=""")
	If Html=1 then
		Response.Write(""&SitePath&"List.asp?ID="&rs1(0)&"""")
	elseif Html=2 then
		Response.Write(""&SitePath&"Html/?"&rs1(0)&".html""")
	elseif Html=3 then
		Response.Write(""&SitePath&"Html/"&rs1(0)&".html""")
	end if
	If target=1 then
	Response.Write(" target=""_blank""")
	End if
	Response.Write(" >")
	If rs1(4)<>"" then
	Response.Write("<font style=""color:"&rs1(4)&""">"&left(rs1(1),Z)&"</font></a>")
	else
	Response.Write(""&left(rs1(1),Z)&"</a>")
	end if
	Response.Write("</li>") & VbCrLf
	rs1.movenext
	loop
	else
	Response.Write("<li>没有</li>")
	end if
	rs1.close
	set rs1=nothing
End Sub

Function Yao_MyID(a)
Yao_MyID=""
 Dim rs1,sql1
 set rs1=server.createobject("ADODB.Recordset")
 sql1="select ID from "&tbname&"_Class where TopID = "&a&""
 rs1.open sql1,conn,1,3
 If Not rs1.Eof Then 
 do while not (rs1.eof or err)

If Yao_MyID = "" then
	Yao_MyID = rs1("ID")
else
	Yao_MyID = Yao_MyID &"|"& rs1("ID")
End if
 rs1.movenext
 loop
 else
Yao_MyID = "0"
 end if
 rs1.close
 set rs1=nothing
End Function

Function Classlist(id)
	if id = "" or isnull(id) then
		Classlist = ""
	else
		Sqld = "Select ClassName from "&tbname&"_Class where ID = " & id
		Set rsd = conn.execute(Sqld)
		if not rsd.eof then
			Classlist = rsd(0)
		else
			Classlist = ""
		end if
		rsd.close
	end if
End Function

Function checkpost(byval back)
	dim server_v1, server_v2
	server_v1 = cstr(request.servervariables("http_referer"))
	server_v2 = cstr(request.servervariables("server_name"))
	if Mid(server_v1, 8, len(server_v2)) <> server_v2 then
		if not back then
			response.write lang_errorpost : response.end
		else
			checkpost = false
		end if
	else
		checkpost = true
	end if
end Function

Function Alert(message,gourl) 
    message = replace(message,"'","\'")
    If gourl="-1" then
        Response.Write ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
    ElseIf gourl="-2" then
        Response.Write ("<script language=javascript>alert('" & message & "');history.go(-2)</script>")
    ElseIf gourl="Close" then
		Response.Write ("<script language=javascript>alert('" & message & "');window.opener=null;window.close();</script>")
	Else
        Response.Write ("<script language=javascript>alert('" & message & "');location='" & gourl &"'</script>")
    End If
    Response.End()
End Function

Function Info(message)
	Response.Redirect ""&SitePath&""&SiteAdmin&"/Info.asp?Info=" & message & ""
    Response.End()
End Function

Function UserInfo(id,Num)
	if id = "" or isnull(id) Then Exit Function
	Sqld = "Select usergroupid,yn from "&tbname&"_User where ID = " & id
	Set rsd = conn.execute(Sqld)
	if not rsd.eof then
		UserInfo 	=rsd(Num)
	end if
	rsd.close
	set rsd=nothing
End Function

'过滤指定html标签

Function lFilterBadHTML(byval strHTML,byval strTAGs)  
  Dim objRegExp,strOutput  
  Dim arrTAG,i
  arrTAG=Split(strTAGs,",")  
  Set objRegExp = New Regexp   
  strOutput=strHTML   
  objRegExp.IgnoreCase = True  
  objRegExp.Global = True  
  For i=0 to UBound(arrTAG)  
    objRegExp.Pattern = "<"&arrTAG(i)&"[\s\S]+</"&arrTAG(i)&"*>"  
    strOutput = objRegExp.Replace(strOutput, "")   
  Next  
  Set objRegExp = Nothing  
  lFilterBadHTML = strOutput   
End Function 

'函数名：EditUserMn
'作用：操作后，给相应用户加分
'参数：str1（被操作的用户名)
'      str2(积分)
'		P_MnType(操作类型，1增加，0减少)
Function EditUserMn(str1,str2,P_MnType)
	dim rs,sql,rs2

	dim EditorTmp,MoneyStr
	sql = "Select UserName From ["&tbname&"_Article] Where ID = "&str1
	Set rs2 = Conn.Execute(sql)
	if not(rs2.eof And rs2.bof) then
		EditorTmp = rs2(0)

		sql = "Select UserMoney From ["&tbname&"_User] Where UserName = '"&EditorTmp&"'"
		Set rs = Server.CreateObject("adodb.recordset")
		rs.open sql,connstr,1,3
		if not(rs.bof and rs.eof) then
			If P_MnType = 1 then
				rs(0) = LaoYRequest(rs(0)) + LaoYRequest(str2)
			else
				rs(0) = LaoYRequest(rs(0)) - LaoYRequest(str2)
			end if
			rs.update
		end if
		rs.close:set rs=nothing
	end if
	
	rs2.close:set rs2=nothing
End Function

'ClassID 链接分类,0为所有
'NUM     调用个数,0为不限
'logo    是否调用logo,1为logo,0为文字
'ClassName是否显示分类名，1为显示

Sub Link(ClassID,Num,logo,ClassName)
	set rs1=server.createobject("ADODB.Recordset")
	SQL1="select"
	If Num<>0 then
		SQL1=SQL1&" top "&Num&""
	End if
	SQL1=SQL1&" * from "&tbname&"_Link where yn <> 0 and datediff('d',Now(),AddTime) <= 0 and datediff('d',Now(),LastTime) > 0"
	If ClassID<>0 then
		SQL1=SQL1&" And ClassID = "&ClassID&""
	End if
	If logo=1 then
		SQL1=SQL1&" And LogoUrl <> ''"
	else
		SQL1=SQL1&" And LogoUrl = ''"
	End if
	SQL1=SQL1&" order by num asc,id asc"	
	rs1.open sql1,conn,1,3
	If Not rs1.Eof Then
	If ClassName=1 then 
		Response.Write("<b>"&linkclassname(rs1("ClassID"))&"：</b>")
	End if
	do while not (rs1.eof or err)
	Response.Write("<a href="""&rs1("LinkUrl")&""" target=""_blank"">")
	If rs1("logourl")<>"" then
		Response.Write("<img src="""&rs1("logourl")&""" width=""88"" height=""31"" alt="""&rs1("Title")&""">")
	Else
		Response.Write(""&rs1("Title")&"")
	End if
	Response.Write("</a>") & VbCrLf
	rs1.movenext
	loop
	end if
	rs1.close
	set rs1=nothing
End Sub

Function linkclassname(id)
	if id = "" or isnull(id) then
		linkclassname = ""
	else
		Sqld = "Select LinkName from "&tbname&"_LinkClass where ID = " & id
		Set rsd = conn.execute(Sqld)
		if not rsd.eof then
			linkclassname = rsd(0)
		else
			linkclassname = ""
		end if
		rsd.close
		set rsd=nothing
	end if
End Function

Function showFace(Str)
	for i = 1 to PingNum
	Str=replace(Str,"[laoy:"&i&"]","<img src="""&SitePath&"images/faces/"&i&".gif""></img>")
	Next
	showFace=Str
End Function

Function ReplaceshowFace(Str)
	for i = 1 to PingNum
	Str=replace(Str,"[laoy:"&i&"]","")
	Next
	ReplaceshowFace=Str
End Function

Function RndNumber(Min,Max) 
Randomize 
RndNumber=Int((Max - Min + 1) * Rnd() + Min) 
End Function

Sub ShowVote(t0)
sqlVote="select top 1 id,title,vote,result,stype from "&tbname&"_vote Where yn = 1"
if clng(t0)<>0 then sqlVote=sqlVote&" And id="&clng(t0)&""
sqlVote=sqlVote&" order by id desc"
set rsVote=conn.execute(sqlVote)
if rsVote.eof then
Response.Write ""
else
   if rsVote(4)=1 then
   v_type="radio"
   else
   v_type="checkbox"
   end if
   Response.Write "<form action="""&SitePath&"Vote.asp?action=add&id="&rsVote(0)&""" method=""post"" target=""vote"">"
   Response.Write "<h5>"&rsVote(1)&"</h5>"
   result=split(rsVote(3),"|")
   for i=0 to ubound(result)
   next
   vote=split(rsVote(2),"|")
   for i=0 to ubound(vote)-1
   Response.Write "<li><input type="""&v_type&"""  name=""vote"" value="""&i&""">"&vote(i)&"</li>"  
   next
   Response.Write "<li><input type=""submit"" value=""投票"" class=""artsubmit"">  <input type=""button"" onclick=""window.open('"&SitePath&"Vote.asp?action=see&id="&rsVote(0)&"')"" value=""查看"" class=""artsubmit""></li>"
   Response.Write "</form>"
end if
RsVote.Close:Set RsVote = Nothing	
End Sub

Function ShowVoteList(P_VoteID)
	dim oRs
	Set oRs = Conn.Execute("Select ID,Title from "&tbname&"_Vote Order by Px asc,ID desc")
	If Not(oRs.eof And oRs.bof) Then
		Do While Not oRs.eof
			ShowVoteList = ShowVoteList &"<option value='"&oRs("ID")&"'"
			if Instr(","& P_VoteID &",",","& oRs("ID") &",") > 0 Then ShowVoteList = ShowVoteList &" selected"
			ShowVoteList = ShowVoteList &">" & oRs("Title")&"</option>" & vbNewLine
			oRs.movenext
		Loop
	Else
		ShowVoteList = "没有!"
	End If
	oRs.Close:Set oRs = Nothing	
End Function

Function ShowVoteList2(P_VoteID)
		dim oRs,b
		Set oRs = Conn.Execute("Select ID,Title from "&tbname&"_Vote Where ID in("&P_VoteID&")")
			b=split(P_VoteID,",")
			For i = 0 to Ubound(b)
			Response.Write("<div class=""artvote"">") & VbCrLf
			Response.Write("	<ul>") & VbCrLf
				Call ShowVote(b(i))
			Response.Write("	</ul>") & VbCrLf
			Response.Write("</div>") & VbCrLf
			Next
		oRs.Close:Set oRs = Nothing	
End Function

Function ChkSB(str)
	ChkSB = True
	For i=0 To Ubound(Split(KillWord,","))
		If Instr(Str,Split(KillWord,",")(i)) > 0 Then
			ChkSB = False
			Exit Function
		End If
	Next
End Function

Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If Err = 0 Then IsObjInstalled = True
	If Err = -2147352567 Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function

Sub Web_Style()
   Dim Sqlp,Rsp,TempStr
   Sqlp ="Select ID,Title from "&tbname&"_Css"   
   Set Rsp=server.CreateObject("adodb.recordset")   
   rsp.open sqlp,conn,1,1 
   If Rsp.Eof and Rsp.Bof Then
      Response.Write("<option value="""">请先添加风格</option>")
   Else
      Do while not Rsp.Eof   
         Response.Write("<option value=""" & Rsp("ID") & """")
		 If int(css)=Rsp("ID") then
				Response.Write(" selected" ) 
		 End if
         Response.Write(">" & Rsp("Title") & "</option>") & VbCrLf
      Rsp.Movenext   
      Loop
   End if
   Rsp.Close:Set Rsp=nothing
End Sub
	
Function ReplaceKey(ByVal Str)
		If IsNull(Str) Then Exit Function
		Dim RsKeyword
		sql="Select * From ["&tbname&"_Key] Order By [Num] Desc"
		Set RsKeyword=Conn.Execute(sql)
		do while not (RsKeyword.eof or err)
		If InStr(Str,RsKeyword("Title")) > 0 Then
			oReplace = RsKeyword("Replace")
			If oReplace=0 then oReplace=-1
			Str = p_replace(Str,RsKeyword("Title"),"<a href="""&RsKeyword("Url")&""" target=""_blank""><font color=blue>"&RsKeyword("Title")&"</font></a>",1,oReplace,1)
		End if	
		RsKeyword.movenext
		loop
		ReplaceKey = Str
		RsKeyword.Close:Set RsKeyword=nothing
End Function

Function p_replace(byval content,byval asp,byval htm,byval aa,byval Rnum,byval bb)
dim Matches,objRegExp,strs,i
strs=content
Set objRegExp = New Regexp
objRegExp.Global = True
objRegExp.IgnoreCase = True
objRegExp.Pattern = "(\<a[^<>]+\>.+?\<\/a\>)|(\<img[^<>]+\>)"'
Set Matches =objRegExp.Execute(strs)
i=0
Dim MyArray()
For Each Match in Matches
ReDim Preserve MyArray(i)
MyArray(i)=Mid(Match.Value,1,len(Match.Value))
strs=replace(strs,Match.Value,"<"&i&">",1,Rnum,1)
i=i+1
Next
if i=0 then
 content=replace(content,asp,htm,1,Rnum,1)
 p_replace=content
 exit Function
end if
strs=replace(strs,asp,htm,1,Rnum,1)
for i=0 to ubound(MyArray)
strs=replace(strs,"<"&i&">",MyArray(i),1,Rnum,1)
next
p_replace=strs
end Function

Function ShowLabel(id)
	if id = "" or isnull(id) then
		ShowLabel = 0
	else
		Sqld = "Select Content from "&tbname&"_Label where ID = " & id
		Set rsd = conn.execute(Sqld)
		if not rsd.eof then
			ShowLabel = rsd(0)
		else
			ShowLabel = ""
		end if
		rsd.close
	end if
End function

Function RandReg(str)
	if str = "" then
		RandReg = ""
	else
		RReg=split(str,CHR(10))
		for i=0 to ubound(RReg)
			RReg1 = RReg(i)
		next
		RandReg = RReg1
	end if
End function
%>