<%
function ChkSql(StrSql)
	if IsNull(StrSql) then
		ChkStr = ""
		exit function 
	end if
	ChkSql = Replace(StrSql, "'", "''")
end function
'Check User Rights
Function checkRights(byVal rightsGroup, byVal rightsFlag)
	Dim theGroup,theGroupItem,rightsString
	checkRights=0
	rightsString=""
  For Each theGroup IN Arr_UserGroup
		theGroupItem=Split(theGroup,"$|$")
		If CInt(theGroupItem(0))=CInt(rightsGroup) Then rightsString=theGroupItem(2)
	Next
	If Len(rightsString)<>5 Then Exit Function
	Select Case rightsFlag
		Case "View"
			checkRights=CInt(Mid(rightsString,1,1))
		Case "Post"
			checkRights=CInt(Mid(rightsString,2,1))
		Case "Edit"
			checkRights=CInt(Mid(rightsString,3,1))
		Case "Delete"
			checkRights=CInt(Mid(rightsString,4,1))
		Case "Upload"
			checkRights=CInt(Mid(rightsString,5,1))
	End Select
End Function

Function CheckLinkStr(Str)
	Str = Replace(Str, "document.cookie", ".")
	Str = Replace(Str, "document.write", ".")
	Str = Replace(Str, "javascript:", "javascript ")
	Str = Replace(Str, "vbscript:", "vbscript ")
	Str = Replace(Str, "javascript :", "javascript ")
	Str = Replace(Str, "vbscript :", "vbscript ")
	Str = Replace(Str, "[", "&#91;")
	Str = Replace(Str, "]", "&#93;")
	Str = Replace(Str, "<", "&#60;")
	Str = Replace(Str, ">", "&#62;")
	Str = Replace(Str, "{", "&#123;")
	Str = Replace(Str, "}", "&#125;")
	Str = Replace(Str, "|", "&#124;")
	Str = Replace(Str, "script", "&#115;cript")
	Str = Replace(Str, "SCRIPT", "&#083;CRIPT")
	Str = Replace(Str, "Script", "&#083;cript")
	Str = Replace(Str, "script", "&#083;cript")
	Str = Replace(Str, "object", "&#111;bject")
	Str = Replace(Str, "OBJECT", "&#079;BJECT")
	Str = Replace(Str, "Object", "&#079;bject")
	Str = Replace(Str, "object", "&#079;bject")
	Str = Replace(Str, "applet", "&#097;pplet")
	Str = Replace(Str, "APPLET", "&#065;PPLET")
	Str = Replace(Str, "Applet", "&#065;pplet")
	Str = Replace(Str, "applet", "&#065;pplet")
	Str = Replace(Str, "embed", "&#101;mbed")
	Str = Replace(Str, "EMBED", "&#069;MBED")
	Str = Replace(Str, "Embed", "&#069;mbed")
	Str = Replace(Str, "embed", "&#069;mbed")
	Str = Replace(Str, "document", "&#100;ocument")
	Str = Replace(Str, "DOCUMENT", "&#068;OCUMENT")
	Str = Replace(Str, "Document", "&#068;ocument")
	Str = Replace(Str, "document", "&#068;ocument")
	Str = Replace(Str, "cookie", "&#099;ookie")
	Str = Replace(Str, "COOKIE", "&#067;OOKIE")
	Str = Replace(Str, "Cookie", "&#067;ookie")
	Str = Replace(Str, "cookie", "&#067;ookie")
	Str = Replace(Str, "event", "&#101;vent")
	Str = Replace(Str, "EVENT", "&#069;VENT")
	Str = Replace(Str, "Event", "&#069;vent")
	Str = Replace(Str, "event", "&#069;vent")
	CheckLinkStr = Str
End Function


Function HTMLEncode(reString) '转换HTML代码
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = UnCheckStr(Str)
		Str = Replace(Str, "&", "&amp;")
		Str = Replace(Str, ">", "&gt;")
		Str = Replace(Str, "<", "&lt;")
		Str = Replace(Str, CHR(32), "&nbsp;")
	    Str = Replace(Str, CHR(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
		Str = Replace(Str, CHR(9), "&#160;&#160;&#160;&#160;")
		Str = Replace(Str, CHR(34),"&quot;")
		Str = Replace(Str, CHR(39),"&#39;")
		Str = Replace(Str, CHR(13), "")
		Str = Replace(Str, CHR(10), "<br>")
		HTMLEncode = Str
	End If
End Function

'Reverse the change made to the content and make it HTML compatible
Function CovHtml(byVal content)
	ON ERROR RESUME NEXT
	CovHtml=content
	IF Not IsNull(content) Then
		CovHtml=UnCheckStr(CovHtml)
		CovHtml=Replace(CovHtml,"&","&amp;")
		CovHtml=Replace(CovHtml,"<","&lt;")
		CovHtml=Replace(CovHtml,">","&gt;")
		CovHtml=Replace(CovHtml,chr(34),"&quot;")
		CovHtml=Replace(CovHtml,chr(39),"&#39;")
	End IF
End Function

'Validate numbers
Function IsInteger(byVal Para)
	IsInteger=False
	If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
		IsInteger=True
	End If
End Function

'Strip macilous strings
Function CheckStr(byVal Chkstr)
	Dim Str,re
	Str=Chkstr
	'IF isnull(Str) Then
		''CheckStr = ""
		''Exit Function 
	'End IF
	'Trim Heading & Trailing New Line chars
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	re.Pattern="(\r\n){3,}"
	str=re.Replace(str,"$1$1$1")
	set re=nothing

	Str = Replace(Str, "'", "''", 1, -1, 1)
	Str = Replace(Str, "select", "sel&#101;ct", 1, -1, 1)
	Str = Replace(Str, "join", "jo&#105;n", 1, -1, 1)
	Str = Replace(Str, "union", "un&#105;on", 1, -1, 1)
	Str = Replace(Str, "where", "wh&#101;re", 1, -1, 1)
	Str = Replace(Str, "insert", "ins&#101;rt", 1, -1, 1)
	Str = Replace(Str, "delete", "del&#101;te", 1, -1, 1)
	Str = Replace(Str, "update", "up&#100;ate", 1, -1, 1)
	Str = Replace(Str, "like", "lik&#101;", 1, -1, 1)
	Str = Replace(Str, "drop", "dro&#112;", 1, -1, 1)
	Str = Replace(Str, "create", "cr&#101;ate", 1, -1, 1)
	Str = Replace(Str, "modify", "mod&#105;fy", 1, -1, 1)
	Str = Replace(Str, "rename", "ren&#097;me", 1, -1, 1)
	Str = Replace(Str, "alter", "alt&#101;r", 1, -1, 1)
	Str = Replace(Str, "cast", "ca&#115;t", 1, -1, 1)
	CheckStr=Str
End Function

'Reverse Stripped strings back
Function UnCheckStr(Str)
		Str=Replace(Str, "sel&#101;ct", "select", 1, -1, 1)
		Str=Replace(Str, "jo&#105;n", "join", 1, -1, 1)
		Str=Replace(Str, "un&#105;on", "union", 1, -1, 1)
		Str=Replace(Str, "wh&#101;re", "where", 1, -1, 1)
		Str=Replace(Str, "ins&#101;rt", "insert", 1, -1, 1)
		Str=Replace(Str, "del&#101;te", "delete", 1, -1, 1)
		Str=Replace(Str, "up&#100;ate", "update", 1, -1, 1)
		Str=Replace(Str, "lik&#101;", "like", 1, -1, 1)
		Str=Replace(Str, "dro&#112;", "drop", 1, -1, 1)
		Str=Replace(Str, "cr&#101;ate", "create", 1, -1, 1)
		Str=Replace(Str, "mod&#105;fy", "modify", 1, -1, 1)
		Str=Replace(Str, "ren&#097;me", "rename", 1, -1, 1)
		Str=Replace(Str, "alt&#101;r", "alter", 1, -1, 1)
		Str=Replace(Str, "ca&#115;t", "cast", 1, -1, 1)
		UnCheckStr=Str
End Function

'Bad Words Filter
Function CheckBadWords(byVal theString)
	Dim WordFilterEntry,WordFilterArray,re,theMatches,tmpString,i
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	For Each WordFilterEntry IN Arr_WordFilter
		WordFilterArray=Split(WordFilterEntry,"$|$")
		'Inject Regular Expression Pattern
		tmpString=""
		For i=1 To Len(WordFilterArray(2))-1
			tmpString=tmpString&Mid(WordFilterArray(2),i,1)&"(["&Mid(WordFilterArray(2),i,1)&"_\s\W]*)"
		Next
		tmpString=tmpString&Right(WordFilterArray(2),1)
		re.Pattern=tmpString
		set theMatches=re.Execute(theString)
		If theMatches.Count>0 Then
			If WordFilterArray(1)="0" Then
				theString=re.Replace(theString,WordFilterArray(3))
			Else
				CheckBadWords=""
				Exit Function
			End If
		End If
	Next
	set theMatches=nothing
	set re=nothing
	CheckBadWords=theString
End Function

'Format Date Time
Function DateToStr(byRef DateTime,byVal ShowType, byVal TimeZone)
	Dim DateYear,DateMonth,DateDay,DateHour,DateMinute,DateSecond,DateAMPM
	DateToStr=ShowType
	DateYear=Year(DateTime)
	DateMonth=Month(DateTime)
	DateDay=Day(DateTime)
	DateHour=Hour(DateTime)
	DateMinute=Minute(DateTime)
	DateSecond=Second(DateTime)
	IF Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	IF Len(DateDay)<2 Then DateDay="0"&DateDay
	If instr(ShowType,"AMPM")>0Then
		If DateHour>12 Then
			DateToStr=Replace(DateToStr,"AMPM","PM")
			DateHour=DateHour-12
		Else
			DateToStr=Replace(DateToStr,"AMPM","AM")
		End IF
	ElseIF Len(DateHour)<2 Then
		DateHour="0"&DateHour	
	End IF
	IF Len(DateMinute)<2 Then DateMinute="0"&DateMinute
	IF Len(DateSecond)<2 Then DateSecond="0"&DateSecond

	DateToStr=Replace(DateToStr,"YYYY",DateYear)
	DateToStr=Replace(DateToStr,"YY",Right(DateYear,2))
	DateToStr=Replace(DateToStr,"MM",DateMonth)
	DateToStr=Replace(DateToStr,"DD",DateDay)
	DateToStr=Replace(DateToStr,"hh",DateHour)
	DateToStr=Replace(DateToStr,"mm",DateMinute)
	DateToStr=Replace(DateToStr,"ss",DateSecond)
	DateToStr=Replace(DateToStr,"TZD",TimeZone)

End Function

'Validate Email Address
Function IsValidUserName(byVal UserName)
	Dim i,c
	IsValidUserName = true
	For i = 1 to Len(UserName)
		c = Lcase(Mid(UserName, i, 1))
		IF InStr("$!<>?#^%@~`&*(){};:+='"" 		", c) > 0 Then
				IsValidUserName = false
				Exit Function
		End IF
	Next
End Function

'Validate Email Address
Function IsValidEmail(byRef Email)
	Dim names, name, i, c
	IsValidEmail = True
	Names = Split(email, "@")
	IF UBound(names) <> 1 then
   		IsValidEmail = False
   		Exit Function
	End IF
	For Each name IN names
		if Len(name) <= 0 Then
     		IsValidEmail = False
     		Exit Function
   		End IF
   		For i = 1 to Len(name)
     		c = Lcase(Mid(name, i, 1))
     		IF InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
       			IsValidEmail = false
       			Exit Function
     		End IF
   		Next
   		IF Left(name, 1) = "." or Right(name, 1) = "." then
      		IsValidEmail = false
      		Exit Function
   		End IF
	Next
	IF InStr(names(1), ".") <= 0 Then
   		IsValidEmail = False
   		Exit Function
	End IF
	i = Len(names(1)) - InStrRev(names(1), ".")
	IF i <> 2 And i <> 3 Then
   		IsValidEmail = False
   		Exit Function
	End IF
	IF InStr(email, "..") > 0 Then
   		IsValidEmail = False
	End IF
End Function

'Multiple Pages
Function MultiPage(ByRef TotalNum,ByRef Perpage,ByRef Curpage,ByRef prefixUrl)
Dim maxPage,showPages,i,prevBound,nextBound,Prev_Page,PageSizeShow,PageCounterSize,PageLink,Next_Page,PageNext
maxPage=int((TotalNum-1)/Perpage)+1
showPages=10 'Even Number

'Calculate Bound Pages
prevBound=curPage-Int(showPages/2)
nextBound=curPage+Int(showPages/2)
If prevBound<=0 Then
	prevBound=1
	nextBound=showPages
End If
If nextBound>maxPage Then
	nextBound=maxPage
	prevBound=maxPage-showPages
End If
If prevBound<=0 Then 	prevBound=1

If maxPage=1 Then
	MultiPage="<span class='multipage-current'> 第1页 </span>"
Else
	'Process First Page
	If prevBound>1 Then MultiPage=MultiPage&"<a href='" & prefixUrl & "Page=1'> &lt;&lt; </a> | "
	'Process Prev Page
	If curPage>1 Then MultiPage=MultiPage&"<a href='" & prefixUrl & "Page=" & (curPage-1) & "'> &lt; </a> | "
	'Process Main
	For i=prevBound to nextBound
		If curPage=i Then
			MultiPage=MultiPage&"<span class='multipage-current'>" &"第"& i &"页"&  "</span> | "
		ElseIf i<=maxPage Then
			MultiPage=MultiPage&"<a href='" & prefixUrl & "Page=" & i & "'> "&i&" </a> | "  
		End If
	Next
	'Process Next Page
	If curPage<maxPage Then MultiPage=MultiPage&"<a href='" & prefixUrl & "Page=" & (curPage+1) & "'> &gt; </a>"
	'Process Last Page
	If nextBound<maxPage Then MultiPage=MultiPage&" | <a href='" & prefixUrl & "Page="&maxPage&"'> &gt;&gt; </a>"
End If
End Function

'Multiple Pages
Function MultiPagehtml(ByRef TotalNum,ByRef Perpage,ByRef Curpage,ByRef prefixUrl)
Dim maxPage,showPages,i,prevBound,nextBound,Prev_Page,PageSizeShow,PageCounterSize,PageLink,Next_Page,PageNext
maxPage=int((TotalNum-1)/Perpage)+1
showPages=10 'Even Number

'Calculate Bound Pages
prevBound=curPage-Int(showPages/2)
nextBound=curPage+Int(showPages/2)
If prevBound<=0 Then
	prevBound=1
	nextBound=showPages
End If
If nextBound>maxPage Then
	nextBound=maxPage
	prevBound=maxPage-showPages
End If
If prevBound<=0 Then 	prevBound=1

If maxPage=1 Then
	MultiPagehtml="<span class='MultiPagehtml-current'> 第1页 </span>"
Else
	'Process First Page
	If prevBound>1 Then MultiPagehtml=MultiPagehtml&"<a href='" & prefixUrl & "-1.html'> &lt;&lt; </a> | "
	'Process Prev Page
	If curPage>1 Then MultiPagehtml=MultiPagehtml&"<a href='" & prefixUrl & "-" & (curPage-1) & "'> &lt; </a> | "
	'Process Main
	For i=prevBound to nextBound
		If curPage=i Then
			MultiPagehtml=MultiPagehtml&"<span class='MultiPagehtml-current'>" &"第"& i &"页"&  "</span> | "
		ElseIf i<=maxPage Then
			MultiPagehtml=MultiPagehtml&"<a href='" & prefixUrl & "-" & i & ".html'> "&i&" </a> | "  
		End If
	Next
	'Process Next Page
	If curPage<maxPage Then MultiPagehtml=MultiPagehtml&"<a href='" & prefixUrl & "-" & (curPage+1) & ".html'> &gt; </a>"
	'Process Last Page
	If nextBound<maxPage Then MultiPagehtml=MultiPagehtml&" | <a href='" & prefixUrl & "-"&maxPage&".html'> &gt;&gt; </a>"
End If
End Function

'Cut String
Function cutStr(byVal str,byVal strlen)
	dim l,t,c,i
	l=Len(str)
	t=0
	For i=1 To l
		'Unicode work around
		c=AscW(Mid(str,i,1))
		If c<0 Or c>255 then t=t+2 Else t=t+1
		if t>=strlen then
			cutStr=left(str,i-3)&"..."
			exit for
		else
			cutStr=str
		end if
	next
End Function

'Split content by lines
Function SplitLines(byVal Content,byVal ContentNums)
	Dim ts,i,l
	IF IsNull(Content) Then Exit Function
	i=1
	ts = 0
	For i=1 to Len(Content)
      	l=Mid(Content,i,2)
      	IF l=vbCrLf Then
         	ts=ts+1
      	End IF
      	IF ts>=ContentNums Then Exit For 
	Next
	IF ts>=ContentNums then
    	Content=Left(Content,i-1)
	End IF
	SplitLines=Content
End Function

'Generate random string
Function RandomString(Length)
	Dim i, tempS
	tempS = "abcdefghijklmnopqrstuvwxyz1234567890" 
	RandomString = ""
	If isNumeric(Length) = False Then 
		Exit Function 
	End If 
	For i = 1 to Length 
		Randomize 
		RandomString = RandomString & Mid(tempS,Int((Len(tempS) * Rnd) + 1),1)
	Next 
End Function 

'Highlight search words
Function searchHighlighter(byVal strContent,byRef arrayWords)
	Dim intCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpdate
	For intPos = 1 to Len(strContent)
		bUpdate = False
		If Mid(strContent, intPos, 1) = "<" Then
			intTagLength = (InStr(intPos, strContent, ">", 1) - intPos)
			strTemp = strTemp & Mid(strContent, intPos, intTagLength)
			intPos = intPos + intTagLength
		End If
		For intCounter = 0 to UBound(arrayWords)
			If arrayWords(intCounter) <> "" Then
				intKeyWordLength = Len(arrayWords(intCounter))
				If LCase(Mid(strContent, intPos, intKeyWordLength)) = LCase(arrayWords(intCounter)) Then
					strTemp = strTemp & "<span class=""highlight"">" & Mid(strContent, intPos, intKeyWordLength) & "</span>"
					intPos = intPos + intKeyWordLength - 1
					bUpdate = True
				End If
			End If
		Next
		If bUpdate = False Then
			strTemp = strTemp & Mid(strContent, intPos, 1)
		End If
	Next
	searchHighlighter = strTemp
End Function

'Fix [quote] [code] cut-off
Function FixUBB(ByVal strContent)
	Dim RE, theMatches, countOpen, countClose, i, j, ubbArray
	ubbArray=Array("code","quote","list")
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	For j=0 To UBound(ubbArray)
	  If ScriptEngineMajorVersion<5 Or ScriptEngineMinorVersion<5 Then
			re.Pattern="\["&ubbArray(j)&"(.*)\]"
		Else
			re.Pattern="\["&ubbArray(j)&"(.*?)\]"
		End If
		Set theMatches=re.Execute(strContent)
		countOpen=theMatches.Count
		re.Pattern="\[\/"&ubbArray(j)&"\]"
		Set theMatches=re.Execute(strContent)
		countClose=theMatches.Count
		Set theMatches=Nothing
		
		For i=1 to countOpen-CountClose
			strContent=strContent&vbCrLf&"...[/"&ubbArray(j)&"]"
		Next
	Next

	FixUBB=strContent
End Function

'Trim [quote] [code]
Function TrimQC(byVal str)
	Dim RE
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True

  If ScriptEngineMajorVersion<5 Or ScriptEngineMinorVersion<5 Then
		re.Pattern="\[quote(.*)\]([^$]*)\[\/quote\](\s)*"
	Else
		re.Pattern="\[quote(.*?)\]([^$]*?)\[\/quote\](\s)*"
	End If
	str=re.Replace(str," ")
  If ScriptEngineMajorVersion<5 Or ScriptEngineMinorVersion<5 Then
		re.Pattern="\[code\]([^$]*)\[\/code\](\s)*"
	Else
		re.Pattern="\[code\]([^$]*?)\[\/code\](\s)*"
	End If
	str=re.Replace(str," ")
	re.Pattern="(\r\n){3,}"
	str=re.Replace(str,"$1$1")
	re.Pattern=" +"
	str=re.Replace(str," ")

	set re=nothing
	TrimQC=Trim(Str)
End Function

'Trim UBB Codes
Function TrimUBB(byVal str)
	Dim RE
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	
  If ScriptEngineMajorVersion<5 Or ScriptEngineMinorVersion<5 Then
		re.Pattern="(\[)([^\]]*)(\])"
	Else
		re.Pattern="(\[)([^\]]*?)(\])"
	End If
	str=re.Replace(str," ")
	re.Pattern=" +"
	str=re.Replace(str," ")

	set re=nothing
	TrimUBB=Trim(Str)
End Function

'Trim HTML
Function TrimHTML(byVal str)
	Dim RE
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True

	str=Replace(str,vbCrLf," ", 1, -1, 1)
	Str = replace(Str, "&gt;", ">", 1, -1, 1)
	Str = replace(Str, "&lt;", "<", 1, -1, 1)
	Str = Replace(Str, "&quot;", CHR(34), 1, -1, 1)
	Str = Replace(Str, "&#39;", CHR(39), 1, -1, 1)
	str = replace(str, "&amp;", "&", 1, -1, 1)
	str = replace(str, "&nbsp;", " ", 1, -1, 1)
	str=Replace(str,"<br>",vbCrLf, 1, -1, 1)
  If ScriptEngineMajorVersion<5 Or ScriptEngineMinorVersion<5 Then
		re.Pattern="(<)([^>]*)(>)"
	Else
		re.Pattern="(<)([^>]*?)(>)"
	End If
	str=re.Replace(str,"")
	re.Pattern=" +"
	str=re.Replace(str," ")

	set re=nothing
	TrimHTML=Str
End Function

'Trackback Function - SiC/CYAN 2004
Function Trackback(byVal trackback_url,byVal url,byVal title,byVal excerpt,byVal blog_name) 
	Dim query_string, objXMLHTTP, objDOM
	title = cutStr(Server.URLEncode(title),100)
	excerpt = Server.URLEncode(cutStr(excerpt, 252))
	url = Server.URLEncode(url)
	blog_name = Server.URLEncode(blog_name)
	query_string = "title="&title&"&url="&url&"&blog_name="&blog_name&"&excerpt="&excerpt

	Set objXMLHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
	Set objDom = Server.CreateObject("Microsoft.XMLDOM")

	'---This is the old GET method of trackback described in Specification---
	'---I put it here just for the memory of history-------------------------
	'		objXMLHTTP.Open "GET", trackback_url&"&"&query_string, false
	'		objXMLHTTP.Send
	'---End Code Segment-----------------------------------------------------

	objXMLHTTP.Open "POST", trackback_url, false
	objXMLHTTP.setRequestHeader "Content-Type","application/x-www-form-urlencoded"

	'Handling timeout
	On Error Resume Next
	
	objXMLHTTP.Send query_string

	If objXMLHTTP.readyState <> 4 then
		objXMLHTTP.waitForResponse 15
	End If

	If Err.Number <> 0 then
		Trackback	= "0$$TrackBack Error : Can not contact Target Server"
	Else
		If (objXMLHTTP.readyState <> 4) Or (objXMLHTTP.Status <> 200) Then
			objXMLHTTP.Abort
			Trackback	= "0$$Trackback Timeout"
		Else
			objDom.async=false
			objDom.loadXML(objXMLHTTP.responseText) 
			If objDom.parseError.errorCode <> 0 Then
				Trackback	= "0$$TrackBack Response Parse Error"
			Else
				If objDom.getElementsByTagName("error")(0).Text="0" Then
					Trackback	= "1$$Trackback Done"
				Else
					Trackback	= "0$$Trackback Error : "&objDom.getElementsByTagName("message")(0).Text
				End If
			End If
		End If
	End If

	Set objXMLHTTP = Nothing
	Set objDom = Nothing

End Function

sub showerrmsg()
	Response.Write"<br>"
	Response.Write"<table cellpadding=3 cellspacing=3 align=center class=""err"" style=""width:50%"">"
	Response.Write"<tr class=14px height=30>"
	Response.Write"<td bgcolor=#f1f1f1><div align=center class=reg_title>提示信息</div><br>"
	Response.Write errmsg
	Response.Write"<br><div align=center><a href=""javascript:history.go(-1)"">返回上一页</a></a>"
	Response.Write"</td>"
	Response.Write"</tr>"
	Response.Write"</table>"
end sub

sub suc(info)
	Response.Write"<br>"
	Response.Write"<table cellpadding=3 cellspacing=3 align=center class=""err"" style=""width:50%"">"
	Response.Write"<tr class=14px height=30>"
	Response.Write"<td bgcolor=#f1f1f1><div align=center class=reg_title>成功信息</div><br>"
	Response.Write info
	Response.Write"<br><div align=center><a href="&Request.ServerVariables("HTTP_REFERER")&">返回上一页</a></a>"
	Response.Write"</td>"
	Response.Write"</tr>"
	Response.Write"</table>"
end sub

Function sqlcheck(sqlstr)
	dim badword
	badword="'|select|update|chr|delete|%20from|;|insert|mid|master.|set|chr(37)|=|net user|xp_cmdshell|exec%20master.dbo.xp_cmdshell|net localgroup administrators|from|drop"

	if sqlstr<>"" then
		chk=split(badword,"|")
		
		for i=0 to ubound(chk)
			if instr(lcase(sqlstr),chk(i))<>0 then
				response.write "<script language=javascript>alert('传参错误！参数 "&sqlstr&" 的值中包含非法字符串！\n\n');window.open('index.asp','_self');</Script>"
				response.end
			end if
		next

	end if
	sqlcheck=sqlstr
End Function


%>

<%


'发送邮件
function sendJmail(strFromEmail,strFromName,strToEmail,strSubject,intBodyType,strBody)
 dim msg
 Set JMail = Server.CreateObject("JMail.Message")
 JMail.Charset = "gb2312"  '邮件文字的代码为简体中文 
 JMail.Logging = true
 'JMail.silent=true
 JMail.From = strFromEmail
 JMail.FromName = strFromName
 JMail.Subject = "sdfsdfsdf"
 JMail.MailServerUserName = "zhu@loweb.com" '发送邮箱用户名
 JMail.MailServerPassword = "zhu-2005" '发送邮箱密码
 JMail.Priority = 3  ''邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值 
 JMail.AddHeader "Originating-IP", Request.ServerVariables("REMOTE_ADDR")
 JMail.AddRecipient(strToEmail)
 if intBodyType=1 then
  JMail.ContentType="text/html"
 end if
 JMail.Body = strBody
 msg=JMail.Send("mail.loweb.com") '发送邮件服务器
 JMail.Close()
 Set JMail = Nothing
 'sendJmail=msg
end function

Function IsIntegers(byVal Para)
	If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
		IsIntegers=para
	else
		response.Write "<script>alert('你输入的参数无效，请重新操作！');window.open('index.asp','_self');</script>"
		response.End()
	end if
End Function

Function RemoveHTMLTag(str)
Set re = New RegExp
re.Pattern = "<[^<>]*>"
re.Global = true
RemoveHTMLTag =re.Replace(str,"") 
Set re = Nothing
End Function

%>
<meta name="author" content="www.wzbhl.com" />
<script language="JavaScript">
<!--
//图片按比例缩放
var flag=false;
function DrawImage(ImgD,ImgW,ImgH){
var image=new Image();
var iwidth =ImgW; //定义允许图片宽度，当宽度大于这个值时等比例缩小
var iheight =ImgH; //定义允许图片高度，当高度大于这个值时等比例缩小
image.src=ImgD.src;
if(image.width>0 && image.height>0){
flag=true;
if(image.width/image.height>= iwidth/iheight){
if(image.width>iwidth){ 
ImgD.width=iwidth;
ImgD.height=(image.height*iwidth)/image.width;
}else{
ImgD.width=image.width; 
ImgD.height=image.height;
}
ImgD.alt=image.width+"×"+image.height;
}
else{
if(image.height>iheight){ 
ImgD.height=iheight;
ImgD.width=(image.width*iheight)/image.height; 
}else{
ImgD.width=image.width; 
ImgD.height=image.height;
}
ImgD.alt=image.width+"×"+image.height;
}
}
} 
//-->

</script>