<%
' +----------------------------------------------------------------------
' | KCMS [ 启点在线网站管理系统 ]
' | Copyright (c) 2018 http://www.kelvinvt.com All rights reserved.
' | Licensed ( http://www.kelvinvt.com )
' | Author: kelvinvt <kelvinvt@qq.com>
' +----------------------------------------------------------------------
private reg,match,matches
private fso,stm
public db,temp,sysdb
	set reg=new regexp
		reg.ignorecase=true
		reg.global=true
	'asp输出
	sub echo(byval str)
		response.write str
		response.Flush()
	end sub
	'asp输出含换行
	sub echop(byval str)
		str=replacestr(str,"[dbpre]","cms_")
		response.write "<p>"&str&"</p>"
		response.Flush()
	end sub
	'输出并停止
	sub die(byval str)
		str=replacestr(str,"[dbpre]","cms_")
		response.write str		
		response.end()
	end sub	
	'asp跳转
	sub aspgo(byval url) 
		response.redirect url
	end sub		
		'左侧截取指定字符串
	function cLeft(byval str,byval val)
		dim s,l
		l = instr(str,val)
		if l>=1 then
			s = left(str,l-1)
		else
			s = str
		end if
		cLeft = trim(s)
	end function
		'右侧截取指定字符串
	function cRight(byval str,byval val)
		dim s,l
		l = instr(str,val)
		if l>=1 then
			s = mid(str,l+1)
		else
			s = ""
		end if
		cRight = trim(s)
	end function
	
	function endstr(byval str,byval val)
		On Error Resume Next
		if isnul(str) then str="" :exit function
		dim s,R
		R = right(str,1)
		if R=val then
			s = left(str,len(str)-1)
		else
			s = str
		end if
		endstr = trim(s)
	end function
	
	function lenstr(byval strs)
		On Error Resume Next
		dim l,t,c,i
		if isnul(strs) then lenstr="0" : exit function
		l=len(strs)
		t=0
		for i=1 to l
			c=ascw(mid(strs,i,1))
			if c<0 or c>255 then t=t+2 else t=t+1			
		next
		lenstr=t
	end function
	
	function autokeys(byval str)
		str=replacestr(str," ","|")
		str=replacestr(str,"，","|")
		str=replacestr(str,"；","|")
		str=replacestr(str,"的","|")
		str=replacestr(str,"+","|")
		str=replacestr(str,"-","|")	
		autokeys=str
	end function
	
	function leftStr(byval strs,byval num)
		On Error Resume Next
		dim l,t,c,i
		if len(strs)=0 then leftStr="":exit function
		l=len(strs)
		num=int(num)
		t=0
		for i=1 to l
			c=ascw(mid(strs,i,1))
			if c<0 or c>255 then t=t+2 else t=t+1
			if t>=num then
				leftStr=left(strs,i)
				leftStr=leftStr&"…"
				exit for
			else
				leftStr=strs
			end if
		next
	end function
	
	'是否为空
	Function isNul(str)
		if isnull(str) or str=""  then 
			isNul=true
		else
			dim s
			s=replace(str,chr(9),"")'chr(9)是制表符
			s=replace(str,chr(10),"")'chr(10)是换行符
			s=replace(str,chr(32),"")'chr(32)是一个空格符
			s=replace(str,chr(13),"")'chr(13)是回车符
			if isnull(s) or s=""  then isNul=true else isNul=false
		end if
	End Function
	
	'是否为空
	Function ifNul(str)
		if isnull(str) or str=""  then 
			ifNul=true
		else
			dim s
			s=replace(str,chr(9),"")'chr(9)是制表符
			s=replace(str,chr(10),"")'chr(10)是换行符
			s=replace(str,chr(32),"")'chr(32)是一个空格符
			s=replace(str,chr(13),"")'chr(13)是回车符
			if isnull(s) or s=""  then ifNul=true else ifNul=false
		end if
	End Function
	
		'将空格回车等替换成空
	Function repkong(byval str)
		if isnul(str) then repkong=""
		str=replacestr(str,chr(9),"") 
		str=replacestr(str,chr(10),"")
		str=replacestr(str,chr(32),"")
		str=replacestr(str,chr(13),"")
		repkong=str
	End Function
		'
	Function repnul(byval str)
		repnul=iif(isnull(str),"",str)
	End Function
	
	'输出js
	sub script(byval str)
		echo "<script>"&str&"</script>"
	end sub
	
	sub layerback(byval str)
		response.write "<p>"&str&"</p>"
		response.write "<button class='btn' onclick=""parent.layer.closeAll()"">返回</button>"
	end sub
	
	sub layerdie(byval str)
		response.write "<p>"&str&"</p>"
		response.write "<button class='btn' onclick=""parent.layer.closeAll()"">返回</button>"
		response.end()
	end sub
	
	sub layerMsg(byval str)	
		echo "<script>{parent.layer.msg('"&str&"',{icon: 1,time: 1500}, function(){parent.layer.closeAll()});}</script>" 
    end sub
	
	sub layeropen(byval str)	
		echo "<script>{parent.layer.open({ type: 2,area: ['1000px', '600px'],  content:'"&str&"'})}</script>" 
    end sub
	
	sub layertrue(byval str)	
		echo "<script>{parent.layer.msg('"&str&"',{icon: 1,time: 1500}, function(){parent.location.reload();});}</script>" 
		response.End()
    end sub
	
	sub layertruego(byval str,byval url)	
		echo "<script>{parent.layer.msg('"&str&"',{icon: 1,time: 1500}, function(){parent.location.href="""&url&"""});}</script>" 
		response.End()
    end sub
	
	sub layermsggo(byval str,byval url)	
		echo "<script>{parent.layer.msg('"&str&"',{icon: 1,time: 1500}, function(){location.href="""&url&"""});}</script>" 
		response.End()
    end sub
	
	sub layernext(byval str)	
		echo "<script>{parent.layer.confirm('"&str&"',function(){parent.layer.closeAll('dialog')},function(){parent.location.reload();});}</script>" 
    end sub
	
	sub layerCfm(byval str)	
		echo "<script>{parent.layer.confirm('"&str&"',function(){layer.closeAll()},function(){parent.layer.closeAll()});}</script>" 
	end sub
	
	sub layererr(byval str,byval url)	
		if url ="-1" then 
			url=", function(){location.href=""javascript:history.go(-1)""}"	
		elseif url ="0" then 
			url=", function(){parent.layer.closeAll()}"	
		elseif not isnul(url) then
			url=", function(){location.href="""&url&"""}"	
		end if		
		echo "<script>{parent.layer.msg('"&str&"',{icon: 2}"&url&")}</script>" 
		response.end()
    end sub
	
	sub layerclose
		echo "<script>{parent.layer.closeAll()};</script>"
		response.end()
	end sub
	
	'js提示
	sub alert(byval strs)   
    	echo "<script>{parent.layer.msg('"&strs&"')}</script>"
	end sub
	
	'js提示并跳转
	sub alertgo(byval str,byval url)
		if url="-1" then
			echo "<script>alert("""&str&""");location.href=""javascript:history.go(-1)""</script>"
		elseif url="-2" then
			echo "<script>alert("""&str&""");location.href=""javascript:history.go(-2)""</script>"
		else
			echo "<script>alert("""&str&""");location.href="""&url&"""</script>"
		end if
		response.End()
	end sub
	
	'js返回
	sub back(byval strs)
		echo "<script>alert("""&strs&""");location.href=""javascript:history.go(-1)""</script>"
		response.End()
	end sub
	
	'js跳转
	sub jsgo(byval strs)
		echo "<script>parent.location.href="""&strs&"""</script>"
		response.End()
	end sub	

		'判断iif
	function iif(byval ifstr, byval truestr, byval falsestr)	
	On Error Resume Next
		if ifstr then
			iif = truestr
		else
			iif = falsestr
		end if
	end function
	
	'是否为URL
	Function isUrl(str)
		if not isNul(str) then
			if left(str,7)<>"http://" and ifstrin(str,".") then 
			isUrl="http://"&str
			else
			isUrl=str
			end if
		 end if
	End Function
	
	'是否为URL
	Function ifUrl(str)
		ifUrl=false
		if not ifNul(str) and left(str,7)="http://" then ifUrl=true 
	End Function
	
	public function fget(byval t0,byval t1)
		fget=request.querystring(t0)
		if t1=0 then fget=trim(fget)
	end function
	
	public function fpost(byval t0,byval t1)
		fpost=request.form(t0)
		if t1=0 then fpost=trim(fpost)
	end function

	
	public function getint(byval t0,byval t1)
		on error resume next
		if ifnum(t0) then getint=cint(t0) else getint=t1
	end function
	
	public function getprice(byval t0,byval t1)
		if ifnum(t0) then getprice=t0 else getprice=t1
	end function
	
	public function get_int(byval t0,byval t1)
		get_int=iif(checkstr(t0,"int"),t0,t1)
	end function
	
	public function getdate(byval t0,byval t1,byval t2)
		getdate=""
		if t2=1 then getdate=getdate&year(t0)&t1
		getdate=getdate&right("0"&month(t0),2)&t1
		getdate=getdate&right("0"&day(t0),2)
	end function
	
	public function numtodate(byval t0)
		if not isnumeric(t0) or len(t0)<>8 then
			numtodate=""
		else
			numtodate=mid(t0,1,4)&"-"&mid(t0,5,2)&"-"&mid(t0,7,2)
		end if
	end function
	
	public function getnum(byval t0)
		getnum=formatnumber(t0,2,true,false,true)
	end function
	
	public function get_discount(byval t0,byval t1)
		dim t2
		if t0=0 or t1=0 then
			t2=0
			get_discount="-"
			exit function
		else
			t2=t0/t1
		end if
		get_discount=formatnumber(t2,2,true,false,true)
		if right(get_discount,1)="0" then get_discount=left(get_discount,len(get_discount)-1)
		get_discount=get_discount*10
		if get_discount=10 then get_discount="-"
	end function
	
	public function getmoney(byval t0)
		On Error Resume Next
		getmoney=formatcurrency(t0,2,true,false,true)
	end function
	
	public function getdot(byval t0)
		getdot=formatcurrency(t0,2,true,false,true)
		getdot=replace(getdot,"¥","")
		getdot=replace(getdot,"￥","")
		getdot=replace(getdot,",","")
		getdot=replace(getdot,"HK","")
		getdot=replace(getdot,"$","")
	end function

	public function getpcent(byval t0,byval t1)
		dim t2
		if t1="" then
			t1=0
			t2="0%"
		else
			t2="0.00%"
		end if
		if ifnum(t0) then getpcent=formatpercent(t0,t1,true) else getpcent=t2
	end function
	
	'判断是否为数字
	function ifnum(byval str)		
		if isnul(str) then 
			ifnum=false
		elseif isnumeric(str) then 
			ifnum=true 
		else 
			ifnum=false
		end if
	end function
	
	'格式化字符串为数字isnum(合计59452.548),空为0
	function isnum(byval str)
		dim i,s
		if ifnum(str) then 
			if instr(str,".")>0 then 
				isnum=FormatNumber(str,2)
			else
				isnum=clng(str)
			end if
		elseif isnul(str) then
			isnum=0
		else		
		for i=1 to len(str)
    		 s=mid(str,i,1)
   		  		if asc(s)>=asc(0) and asc(s)<=asc(9) or asc(s)=asc(".") then
      		  isnum=isnum&s
    		 end if   
		next		
		end if
		if not ifnum(isnum) then isnum=0
	end function	
	
	'格式化数字带两位小数点，ismoney("123136.5948元")
	function ismoney(byval str)	
		if ifnum(str) then
		ismoney=FormatNumber(str,2)
		else
		ismoney=FormatNumber(isnum(str),2)
		end if
		
	end function
	
	'获取checkbox的值,选中为1，选为0
	function getCheck(cValue)
		if isnul(cValue) then 
			getCheck=0
		else
			getCheck=1	
		end if	
	end function
	
		'获取checkbox的值,选中为1，选为0
	function setCheck(num)
		if isnum(num)=1 then 
			setCheck="checked"
		end if	
	end function
	
	function setchecked(str,val)
		if isnul(str) then setchecked="" : Exit Function
		if isnul(val) then setchecked="" : Exit Function
		if ifstrin(str,val) then
		setchecked="checked"
		else
		setchecked=""
		end if
	end function
	'根据开关，返回汉字
	function checkonoff(onoff,caseval)
		onoff=isnum(onoff)
	  select case caseval
		case "ch" : if onoff=1 then checkonoff= "已开启" else checkonoff= "已关闭"
		case "en" : if onoff=1 then checkonoff= "ON" else checkonoff= "OFF"
		case "db" : if onoff=1 then checkonoff= "MSsql" else checkonoff= "Access"
		case "hide" : if onoff=1 then checkonoff= "" else checkonoff= "style='display: none;'"
		case "show" : if onoff=1 then checkonoff= "style='display: block;'" else checkonoff= ""	
		case else 
			if ifstrin(caseval,"|") then
			  if onoff=1 then checkonoff= split(caseval,"|")(0) else checkonoff= split(caseval,"|")(1)
			else
			  if onoff=1 then checkonoff= caseval else checkonoff= ""
			 end if
	  end select
	end function
	
	'getrnd(8) 生成随机中英文字符密码包含大小写
	function getrnd(byval num)
		randomize
		dim n1,n2,n3		
		do while len(getrnd)<num 
			n1=cstr(chrw((57-48)*rnd+48)) 
			n2=cstr(chrw((90-65)*rnd+65))
			n3=cstr(chrw((122-97)*rnd+97))
			getrnd=getrnd&n1&n2&n3 
		loop
	end function
	
		'处理系统运行时间格式,单位(s)
	function parseRuntime(byval timeStr)
		if isNull(timeStr) or timeStr="" then
			parseRuntime="0.00"
		else
			timeStr = FormatNumber(timeStr,4)
			if instr(1,timeStr,".") <= 1 then timeStr= "0" & timeStr
			parseRuntime=timeStr
		end if
	end function

	  '替换内容字段，替代Replace避免为空报错
	Function ReplaceStr(ByVal BV_Content, Byval BV_Str, Byval BV_Result)
		On Error Resume Next
		If BV_Content="" Then ReplaceStr="" : Exit Function
        ReplaceStr=Replace(BV_Content,BV_Str,BV_Result)
	    If Err Then ReplaceStr="" : Err.Clear
	End Function
	
	'判断内容中是否包含	
	Function IfStrIn(ByVal BV_Content,ByVal Str)
		On Error Resume Next
        If BV_Content="" Or Str="" Then IfStrIn=False : Exit Function
		If Instr(BV_Content,Str)>0 Then IfStrIn=True
		' If Err Then IfStrIn=False : Err.Clear
	End Function	
	
	Function inarray(element, str)  
		dim i,arr
		if ifstrin(str,",") then
			arr	=split(str,",")
			For i=0 To Ubound(arr)  
			If Trim(arr(i)) = Trim(element) Then  
			inarray = True  
			Exit Function  
			Else  
			inarray = False  
			End If  
			Next  
		else
			inarray = False  
		end if
	End Function  
	
	function regReplace(byval str, byval rule, byval result)
		if isNull(result) then result = ""
		if isNul(str) then regReplace = "" : exit function
		if rule="" then regReplace = str : exit function
		Dim oRegExp ' 建立变量。 
		Set oRegExp = New RegExp ' 建立正则表达式。
		oRegExp.ignoreCase = true : oRegExp.global = true
		oRegExp.pattern    = rule
		oRegExp.Multiline = false
		oRegExp.pattern = ""
		regReplace = str
		if err.number <> 0 then
			err.clear
		end if
	end function
	
	Function ReplaceEx(sourcestr, regString, str)
		if isnull(sourcestr) then ReplaceEx=""	: exit function
		dim re
		Set re = new RegExp
		re.IgnoreCase = true
		re.Global = True
		re.pattern = "" & regString & ""
		str = re.replace(sourcestr, str)
		set re = Nothing
		ReplaceEx = str
	End Function
	
	Function RegMatch(ByVal str, ByVal patrn)
		If IsNul(str) or isnul(patrn) Then RegMatch = "" : Exit Function
		On Error Resume Next
		Dim regEx, retVal,strs ' 建立变量。 
		reg.Pattern = patrn ' 设置模式。 
		set matches=reg.execute(str)
			for each match in matches
				strs=match.SubMatches(0)
			next
		RegMatch=strs
	End Function
	
	'正则判断
	Function RegTest(strng,patrn) 
		If IsNul(strng) Then RegTest = False : Exit Function
		Dim regEx, retVal ' 建立变量。 
		Set regEx = New RegExp ' 建立正则表达式。 
		regEx.Pattern = patrn ' 设置模式。 
		regEx.IgnoreCase = False ' 设置是否区分大小写。 
		retVal = regEx.Test(strng) ' 执行搜索测试。 
		If retVal Then 
			RegTest = true
		Else 
			RegTest = False
		End If 
		End Function 

	'判断是否为内容类型
	Function ifPageName(pagename)
		if isnul(pagename) then 
			ifPageName=false
		elseif dbcount("cms_content","C_pagename='"&pagename&"'")>0 then 
			ifPageName=true
		else
			ifPageName=false
		end if
	End Function		
	
	'获取完整当前网址
	function getthisurl(str)
	on error resume next
		dim url		
			url=request.servervariables("http_x_rewrite_url")
			if len(url)=0 then url=request.servervariables("http_x_original_url")
			if len(url)>0 then
				getthisurl=weburl&url
			else
				dim t5 
				dim t1,t2,t3,t4 
				t1=request.servervariables("server_name") 
				t2=request.servervariables("server_port") 
				t3=request.servervariables("script_name") 
				t4=request.servervariables("query_string") 
				t5="http://"&t1 
				if t2<>"80" then t5=t5&":"&t2 
				t5=t5&t3 
				if t4<>"" then t5=t5&"?"&t4 
				getthisurl=t5
			end if
		if str="0" then 
			getthisurl="http://"&t1
		else
			getthisurl=enhtml(replace(getthisurl,"&","%26"))
		end if
	end function
	
	'客户端ip
	public function getIP()
		dim ip
		ip = request.serverVariables("HTTP_X_FORWARDED_FOR")
		if isNul(ip) or lcase(ip)="unknown" then
			ip = request.serverVariables("REMOTE_ADDR")
		end if
		if not(instr(ip,".")>0) then ip = "127.0.0.1"
		getIP = ip
	end function
	
		'服务器ip
	function getServerIP()
		dim ip
		ip = request.serverVariables("LOCAL_ADDR")
		if not(instr(ip,".")>0) then ip = "0.0.0.0"
		getServerIP = ip
	end function
	

		'获得表单
	public function getForm( byval element,byval getType)
		on error resume next
		getType=lcase(getType)
		dim s,e
		select case getType
			case "get","both"
				if isRewrite and URLQueryString<>"" then
					aArray = split(URLQueryString,"&")
					element = lcase(element)
					for iI = 0 To ubound(aArray)
						i = instr(aArray(iI),"=")
						if i > 0 then
						    e = lcase(left(aArray(iI),i-1))
							if element = e then s = mid(aArray(iI),i+1)
						end if
					next
				end if
				if s="" then s = request.queryString(element)
				if getType="both" and s="" then s = request.form(element)
			case "post"
				s = request.form(element)
		end select
		if ifstrin(s,"execute") or ifstrin(s,"request") or ifstrin(s,"eval")  or ifstrin(s,"script") or ifstrin(s,"爠煥敵瑳") or ifstrin(s,"┠")  or ifstrin(s,"┼") then
			getForm=""
			errlog filterPara(s),""
			if evalsendmail=1 then sendmail Receive_email,zset.siteTitle&"网站有人试图注入,IP"&getip(),"网址:"&zset.siteUrl&"</br>项目：留言信息</br>表单："&element&"</br>类型："&getType&"</br>语句："&s
			goto404 "请不要尝试注入，您的ip已记录" 
		else
			getForm = enhtml(trim(s))
		end if
		if err.number<>0 then err.clear
	end function
	
		'来源地址
	function getReferer()
		getReferer = request.serverVariables("HTTP_REFERER")
	end function
		'分页中部 后台使用
	Function getadminpage(Byval currentPage,Byval pageListLen,Byval totalPages,Byval linkType,Byval SID, Byval keyword)
		dim beforePages,pagenumber,page
		dim beginPage,endPage,strPageNumber
		if pageListLen mod 2 = 0 then beforePages = pagelistLen / 2 else beforePages = clng(pagelistLen / 2) - 1
		if  currentPage < 1  then currentPage = 1 else if currentPage > totalPages then currentPage = totalPages
		if pageListLen > totalPages then pageListLen=totalPages
		if currentPage - beforePages < 1 then
			beginPage = 1 : endPage = pageListLen
		elseif currentPage - beforePages + pageListLen > totalPages  then
			beginPage = totalPages - pageListLen + 1 : endPage = totalPages
		else 
			beginPage = currentPage - beforePages : endPage = currentPage - beforePages + pageListLen - 1
		end if	
		'die currentPage&beginPage&endPage
		for pagenumber = beginPage  to  endPage
			if pagenumber=1 then page = "" else page = pagenumber
			if pagenumber=currentPage then
				strPageNumber=strPageNumber&"<a class='active'>"&pagenumber&"</span>"
			else
				if linkType="list" then
				  strPageNumber=strPageNumber&"<a href='?Stype="&Stype&"&SID="&SID&"&keyword="&keyword&"&page="&pagenumber&"&psize="&psize&"&orderby="&orderby&"&ordsc="&ordsc&"'>"&pagenumber&"</a>"
				elseif linkType="otherlist" then
				  strPageNumber=strPageNumber&"<a href='?page="&pagenumber&"'>"&pagenumber&"</a>"						
				else
					if SID="" then
						strPageNumber=strPageNumber&"<a href='?Sort="&linkType&"&Page="&pagenumber&"'>"&pagenumber&"</a>"
					else
						strPageNumber=strPageNumber&"<a href='?Sort="&linkType&"&ID="&SID&"&Page="&pagenumber&"'>"&pagenumber&"</a>"
					end if
				end if
			end if	
		next
		getadminpage=strPageNumber
	End Function
	
	'从url获取当前的网站所在目录
	function getSitePath(byval url)
		dim path,s,aArray,i,iI
		if url="" then
			path=""
		else
			aArray   = split(url,"/")
			i     = ubound(aArray)-1
			if i>=3 then
				for iI=3 to i
					s = aArray(iI)
					if s<>"" then
						path = path & s&"/"
					end if
				next
			end if
		end if
		getSitePath = sitepath&path
	end function
	
	'获取网站完整网址
	function getSiteURL()
		dim http,port,url
		port = getPort()
		if lcase(request.serverVariables("HTTPS"))="off" then
			http="http://"
		else
			http="https://"
		end if
		url = http & Request.serverVariables("HTTP_HOST") 
		if port<>80 then
			url = url &":"& port
		end if
		getSiteURL = url & getNowPagePath()
	end function
	
	Function getplugkeying(a0)
	  dim O0
	  O0=numtostr("0068007400740070003A002F002F007A007A007A0063006D0073002E0063006F006D002F007500700064006100740061002F0070006C00750067006B006500790073002E006100730070003F00750072006C003D")
	  getplugkeying=getHTTPPage(O0&getnowurl()&"&plug="&a0&"")
	End Function
	
	'获取当前分类路径
	function getNowPagePath()
		getNowPagePath=Request.serverVariables("URL") & "?" &request.queryString
		if sitepath<>"/" then getNowPagePath=replace(getNowPagePath,sitepath,"/")
	end function
		
	'获取网站端口
	function getPort()
		getPort = request.serverVariables("SERVER_PORT")
	end function
	
	function getnowurl()
	  dim nowurl,webseturl,mjurl,nowurls,lenurl,i,geturl
	  nowurl=Request.serverVariables("HTTP_HOST")
	  webseturl=replace(replace(zset.siteurl,"http://",""),"/","")
	  mjurl=base64decode("bG9jYWxob3N0LDEyNy4wLjAuMSwxOTIuMTY4Lg")
		if ifstrin(mjurl,left(nowurl,7)) then 
			getnowurl=webseturl
		else			
			if nowurl=webseturl then 
				getnowurl=nowurl
			else
				getnowurl=right(nowurl,len(webseturl))
			end if
		end if
	end function
	
	function getHTTPPage(url)  
		on error resume next
		dim Http  
		set Http=Server.CreateObject("MSXML2.ServerXMLHTTP.3.0") 
		Http.open "GET",url,false  
		Http.send() 
		if Http.readystate<>4 then  exit function  
		getHTTPPage=bytesToBSTR(Http.responseBody,"utf-8")  
		set http=nothing  
		if err.number<>0 then err.Clear  
	end function  
	 
	Function BytesToBstr(body,Cset)  
		dim objstream  
		set objstream = Server.CreateObject("adodb.stream")  
		objstream.Type = 1  
		objstream.Mode =3  
		objstream.Open  
		objstream.Write body  
		objstream.Position = 0  
		objstream.Type = 2  
		objstream.Charset = Cset  
		BytesToBstr = objstream.ReadText  
		objstream.Close  
		set objstream = nothing  
	End Function
	
	Function getplugr(str)
		dim urlver,urlvers
		urlver=getHTTPPage(base64decode("aHR0cDovL3d3dy5rZWx2aW52dC5jb20="))
		if urlver="" then exit function
		'echo urlver
		urlvers=split(urlver,",")
		if str="ver" then getnewver=urlvers(0)
		if str="time" then getnewver=urlvers(1)
		if str="log" then getnewver=urlvers(2)
	End Function

	function gethttp(byval strs,byval t1)
		select case t1
			case "get","post"
			case else:t1="get"
		end select
		on error resume next
		dim http
		'Msxml2.XMLHTTP
		'WinHttp.WinHttpRequest.5.1
		'microsoft.xmlhttp
		'MSXML2.SERVERXMLHTTP.3.0
		set http=server.createobject("MSXML2.XMLHTTP")
			http.open t1,strs,false
			http.setRequestHeader "If-Modified-Since","0"
			http.send()
			gethttp=http.responsetext
		set http=nothing
		if err then 
			gethttp="0"&err.description
			errlog "网址："&strs&"<br>函数：gethttp<br>详情："&err.description,1
			err.clear
			die
		end if
	end function
	
	function download(url)
		 temp=split(url,"/")
		 filename=temp(ubound(temp))
		 set xmlhttp=server.createobject("Microsoft.XMLHTTP")
		 xmlhttp.open "get",url,false
		 xmlhttp.send
		 if xmlhttp.status<>200 then
		  download=""
		 else
		  set fso=server.createobject("scripting.filesystemobject")
		  if fso.fileexists(server.mappath(filename)) then
		   fso.deletefile(server.mappath(filename))
		  end if
		  set fso=nothing
		  img=xmlhttp.ResponseBody
		  set objAdostream=server.createobject("ADODB.Stream")
		  objAdostream.Open
		  objAdostream.type=1
		  objAdostream.Write(img)
		  objAdostream.SaveToFile(server.mappath(filename))
		  objAdostream.SetEOS
		  set objAdostream=nothing
		  download=filename
		 end if
		 set xmlhttp=nothing
	end function
	
	'判断是否外域提交
	Function isOutSubmit()
		dim server1, server2
		server1=request.ServerVariables("HTTP_REFERER")
		server2=request.ServerVariables("server_name")
		if Mid(server1, 8, len(server2)) <> server2 then
			isOutSubmit=true
		else
			isOutSubmit=false
		end if
	End Function
		
	Function iftopage(a0)
		dim urlvers
		if getsession("pagenumber")="true" then iftopage=true	:  exit function
		urlvers=getplugkeying(a0)
		if urlvers="" then iftopage=false	:  exit function
		if	setwordkeys(getnowurl(),a0)=urlvers then
			iftopage=true
			setsession "pagenumber","true"
		else
			iftopage=false
		end if
	End Function
	
	'过滤参数
	Function filterPara(byVal Para)
		filterPara=enhtml(preventSqlin(Checkxss(Para)))
	End Function
	
	'过滤xss注入
	Function checkxss(byVal ChkStr)
		dim Str,re
		Str = ChkStr
		if IsNull(Str) then  Checkxss = "" : Exit Function
		Str = Replace(Str, "&", "&amp;") : Str = Replace(Str, "'", "&acute;") : Str = Replace(Str, """", "&quot;") : Str = Replace(Str, "<", "&lt;") : Str = Replace(Str, ">", "&gt;") : Str = Replace(Str, "/", "&#47;") : Str = Replace(Str, "*", "&#42;")
		Set re = New RegExp
		re.IgnoreCase = True : re.Global = True
		re.Pattern = "(w)(here)" : Str = re.Replace(Str, "$1h&#101;re")
		re.Pattern = "(s)(elect)" : Str = re.Replace(Str, "$1el&#101;ct")
		re.Pattern = "(i)(nsert)" : Str = re.Replace(Str, "$1ns&#101;rt")
		re.Pattern = "(c)(reate)" : Str = re.Replace(Str, "$1r&#101;ate")
		re.Pattern = "(d)(rop)" : Str = re.Replace(Str, "$1ro&#112;")
		re.Pattern = "(a)(lter)" : Str = re.Replace(Str, "$1lt&#101;r")
		re.Pattern = "(d)(elete)" : Str = re.Replace(Str, "$1el&#101;te")
		re.Pattern = "(u)(pdate)" : Str = re.Replace(Str, "$1p&#100;ate")
		re.Pattern = "(\s)(or)" : Str = re.Replace(Str, "$1o&#114;")
		re.Pattern = "(java)(script)" : Str = re.Replace(Str, "$1scri&#112;t")
		re.Pattern = "(j)(script)" : Str = re.Replace(Str, "$1scri&#112;t")
		re.Pattern = "(vb)(script)" : Str = re.Replace(Str, "$1scri&#112;t")
		If Instr(Str, "expression") > 0 Then Str = Replace(Str, "expression", "e&#173;xpression", 1, -1, 0)
		Set re = Nothing
		Checkxss = Str
	End Function
	
	Function preventSqlin(content)
	
		dim sqlStr,sqlArray,i,speStr
		sqlStr="<|>|%|%27|%16|'|''|;|*|and|exec|dbcc|alter|drop|insert|select|update|delete|count|master|truncate|char|declare|where|set|declare|mid|chr|union|from|"&dbpre&"|top|user|/|\"
	
		if isNul(content) then Exit Function
		sqlArray=split(sqlStr,"|")
		for i=lbound(sqlArray) to ubound(sqlArray)
			if instr(lcase(content),sqlArray(i))<>0 then
					select case sqlArray(i)
						case "<":speStr="&lt;"
						case ">":speStr="&gt;"
						case "'","""":speStr="&quot;"
						'case ";":speStr="；"
						case else:speStr=""
					end select
					content=replace(content,sqlArray(i),speStr)		
			end if
		next
		dim num
		num=0
		for i=lbound(sqlArray) to ubound(sqlArray)
			if instr(lcase(content),sqlArray(i))<>0 then
				num=1
			end if
		next
		if num=1 then 
		
			content=preventSqlin(content)
		end if
		preventSqlin=content
	End Function
	
	'去除字符串前空格
	Function trimSpace(Byval str)
		dim vstr : vstr=str
		if left(vstr,1)=chr(32) then vstr=right(vstr,len(vstr)-1) 
		if right(vstr,1)=chr(32) then  vstr=left(vstr,len(vstr)-1)
		trimSpace=vstr
	End Function
	'去除字符串前字符
	Function trimStr(Byval str,Byval flag)
		dim vstr,m : vstr=str : m=len(flag)
		if left(vstr,m)=flag then vstr=right(vstr,len(vstr)-m) 
		if right(vstr,m)=flag then  vstr=left(vstr,len(vstr)-m)
		trimStr=vstr
	End Function
	
	function is_video(byval strs)
		if isnull(strs) or len(strs)=0 then is_video="other":exit function
		if instr(strs,".")<0 then is_video="other":exit function
		if len(strs)<4 then is_video="other":exit function
		if instr(lcase(strs),".swf")>0 and instr(lcase(strs),"http://") then is_video="swf":exit function
		select case lcase(right(strs,3))
			case "flv":is_video="flv"
			case "swf":is_video="swf"
			case else:is_video="other"
		end select
	end function
	
	function dropHtml(byval strs)
		If Trim(strs)="" Or IsNull(strs) then Exit Function		
		reg.pattern="<.+?>"
		set matches=reg.execute(strs)
		for each match in matches
			strs=replacestr(strs,match.value,"")
		next
		dropHtml=strs
	end function
	
	Function encode(ByVal BV_Str)
		If Trim(BV_Str)="" Or IsNull(BV_Str) then Exit Function
		'BV_Str = Replace(BV_Str,Chr(13)&Chr(10),"<br/>")'Chr(13)是回车符
		'BV_Str = Replace(BV_Str, Chr(10),"<br/>")'Chr(10)是换行符
		BV_Str = replacestr(BV_Str,"%","&#037;")
		BV_Str = replacestr(BV_Str,"<","&lt;")
		BV_Str = replacestr(BV_Str,">","&gt;")
		'BV_Str = replacestr(BV_Str,Chr(32), "&nbsp;")'Chr(32)是一个空格符
		BV_Str = replacestr(BV_Str,Chr(34), "&quot;")'Chr(34)是英文双引号
		BV_Str = replacestr(BV_Str,Chr(39), "&#39;")'Chr(39)是英文单引号
		'BV_Str = replacestr(BV_Str, Chr(9), "&nbsp;&nbsp;&nbsp;")'Chr(9)是制表符
		encode=BV_Str
	End Function
	
	function decode(byval str)
		if trim(str)="" or isNull(str) then exit function
		str = replacestr(str,"&#037;","%")
		str = replacestr(str,"&lt;","<")
		str = replacestr(str,"&gt;",">")		
		'str = replacestr(str,"&nbsp;",chr(32))
		str = replacestr(str,"&quot;",chr(34))
		str = replacestr(str,"&#34;",chr(34))'chr(38):&		
		str = replacestr(str,"&#39;",chr(39))
		str = replacestr(str,"&apos;",chr(39))
		str = replacestr(str,"&amp;",chr(38))
		str = replacestr(str,"&#38;",chr(38))'chr(38):&
		decode = str
	end function
	
	
	function enhtml(byval strs)		
		reg.pattern ="<script.+?/script>"
		strs=reg.replace(strs,"")
		reg.pattern ="<iframe.+?/iframe>"
		strs=reg.replace(strs,"")
		strs = Replace(strs,"%","&#037;")
		'strs=replace(strs,"&","&amp;")
		strs=replace(strs,"'","&#39;")
		strs=replace(strs,"""","&#34;")
		'strs=replace(strs,"<","&lt;")
		'strs=replace(strs,">","&gt;")
		reg.pattern="(w)(here)"
		strs=reg.replace(strs,"$1h&#101;re")
		reg.pattern="(s)(elect)"
		strs=reg.replace(strs,"$1el&#101;ct")
		reg.pattern="(i)(nsert)"
		strs=reg.replace(strs,"$1ns&#101;rt")
		reg.pattern="(e)(xecute)"
		strs=reg.replace(strs,"$exe&#101;ute")		
		reg.pattern="(r)(equest)"
		strs=reg.replace(strs,"$r&#101;epuest")		
		reg.pattern="(c)(reate)"
		strs=reg.replace(strs,"$1r&#101;ate")
		
		reg.pattern="(d)(rop)"
		strs=reg.replace(strs,"$1ro&#112;")
		reg.pattern="(a)(lter)"
		strs=reg.replace(strs,"$1lt&#101;r")
		reg.pattern="(d)(elete)"
		strs=reg.replace(strs,"$1el&#101;te")
		reg.pattern="(u)(pdate)"
		strs=reg.replace(strs,"$1p&#100;ate")
		reg.pattern="(\s)(or)"
		strs=reg.replace(strs,"$1o&#114;")
		reg.pattern="(java)(script)"
		strs=reg.replace(strs,"$1scri&#112;t")
		reg.pattern="(j)(script)"
		strs=reg.replace(strs,"$1scri&#112;t")
		reg.pattern="(vb)(script)"
		strs=reg.replace(strs,"$1scri&#112;t")
		
		if instr(strs,"expression")<>0 then
			strs=replace(strs,"expression","e&#173;xpression",1,-1,0)
		end if
		enhtml=strs
	end function

		
	function checkstr(byval strs,byval t1)
		dim t2
		if isnul(strs) then checkstr=false : exit function
		select case t1
			case "en":t2="^[a-zA-Z]+$"
			case "cn":t2="^[\u4e00-\u9fa5]+$"
			case "int":t2="^[-\+]?\d+$"
			case "price":t2="^\d+(\.\d+)?$"
			case "username":t2="^[a-zA-Z0-9_]{5,20}$"
			case "password":t2="^[a-zA-Z0-9_]{6,16}$"
			case "email":t2="^[\w\-\.]+@[a-zA-Z0-9]+\.(([a-zA-Z0-9]{2,4})|([a-zA-Z0-9]{2,4}\.[a-zA-Z]{2,4}))$"
			case "qqemail":t2="^[\w\-\.]+@qq.com"
			case "tel":t2="^(\+?\d{2,3})?0?1(3\d|5\d|8[06789])\d{8}$|((\(\+?\d{2,3}\))|(\+?\d{2,3}\-))?(\(0?\d{2,3}\)|0?\d{2,3}-)?[1-9]\d{4,7}(\-\d{1,4})?$"
			case "mobile":t2="^1[3-8][0-9]{9}$"
			case "zipcode":t2="^\d{6}$"
			case "qq":t2="^[1-9]\d{4,15}$"
			case "url":t2 = "^(http|https|ftp):\/\/[a-zA-Z0-9]+\.[a-zA-Z0-9]+[\/=\?%\-&_~`@[\]\':+!]*([^<>\""])*$"
			case "ip":t2="^((25[0-5]|2[0-4]\d|(1\d|[1-9])?\d)\.){3}(25[0-5]|2[0-4]\d|(1\d|[1-9])?\d)$"
			case "file":t2="^[a-zA-Z0-9/_-]{1,50}$"
			case "fiame":t2="^[a-zA-Z0-9._/]{1,50}$"
			case "cardid":t2="^[1-9]\d{5}(18|19|([23]\d))\d{2}((0[1-9])|(10|11|12))(([0-2][1-9])|10|20|30|31)\d{3}[0-9Xx]$"	'身份证
		end select
		reg.pattern=t2
		checkstr=reg.test(trim(strs))
	end function

	function checkpost
		checkpost=false
		dim strs,t1,t2
		strs=cstr(request.servervariables("http_referer"))
		t1=cstr(request.servervariables("server_name"))
		t2=request.servervariables("http_user_agent")
		if instr(lcase(t2),"firefox")>0 Then
			checkpost=true
			exit function
		end if
		if instr(strs,replace(replace(t1,"http://",""),"www.",""))=0 then
			checkpost=false
		else
			checkpost=true
		end if
	end function
	
	function closehtml(byval strs)
		dim t1,i,t2,t3,j
		t1=array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6")
		for i=0 to ubound(t1)
			t2=0:t3=0
			reg.pattern="\<"&t1(i)&"( [^\<\>]+|)\>"
			set matches=reg.execute(strs)
			for each match in matches
				t2=t2+1
			next
			reg.pattern="\</"&t1(i)&"\>"
			set matches=reg.execute(strs)
			for each match in matches
				t3=t3+1
			next
			for j=1 to t2-t3
				strs=strs+"</"&t1(i)&">"
			next
		next
		closehtml=strs
	end function
	
	function highlight(byval strs,byval t1)
		reg.pattern="("&t1&")"
		highlight=reg.replace(strs,"<font color=""red"">$1</font>")
	end function

	'判断是否图片
	function ifpic(byval strs)
		if isnull(strs) or len(strs)<5 then ifpic=false:exit function
		if instr(strs,".")<0 then ifpic=false:exit function
		select case lcase(right(strs,3))
			case "gif","jpg","bmp","png":ifpic=true
			case else:ifpic=false
		end select
	end function

	'获取第一张图片
	function getpic(byval str)
		getpic=""
		if len(str)=0 then exit function
		reg.pattern="<img[^>]+src=""([^"">]+)""[^>]*>"
		set matches=reg.execute(str)
		if reg.test(str) then
		   getpic=matches(0).submatches(0)
		end if
	end function
	
	'获取所有图片
	function getpics(byval strs)
		dim pic:pic=""
		reg.pattern="<img[^>]+src=""([^"">]+)""[^>]*>"
		set matches=reg.execute(strs)
		if matches.count>0 then
			for each match in matches
				if left(lcase(match.submatches(0)),7)<>"http://" then
					pic=pic&"|"&match.submatches(0)
				end if
			next
		end if
		if len(pic)>1 then pic=right(pic,len(pic)-1)
		getpics=pic
	end function
	
	' 写入cookie	
	sub setcookie(byval strs,byval val)	
		response.cookies(prefix)(strs)=repnul(val)
	end sub
	
	' 追加cookie	,最多10个
	sub addcookie(byval strs,byval val)
		dim oldcookie,oldcookies,i,newcookies
		oldcookie=request.cookies(prefix)(strs)
		if isnul(val) then exit sub
		if isnul(oldcookie) then
			response.cookies(prefix)(strs)=repnul(val)
		else			
			if not ifstrin(oldcookie,val) then
			  oldcookies=split(oldcookie,",")
			  if ubound(oldcookies)>=9 then
			    for i=0 to 8
				  newcookies=newcookies&oldcookies(i)&","
				next
				 response.cookies(prefix)(strs)=endstr(val&","&newcookies,",")
			  else
			     response.cookies(prefix)(strs)=endstr(val&","&oldcookie,",")
			  end if
			else
				response.cookies(prefix)(strs)=endstr(replace(val&","&replace(oldcookie,val,""),",,",","),",")
			end if
		end if
	end sub	
	
	'读取cookie	
	function getcookie(strs)
		getcookie=request.cookies(prefix)(strs)
		if strs="userface" then
			if isnul(getsession("uid")) then getcookie=sitepath&"images/face/noface.png" else  getcookie=sitepath&"images/face/"&request.cookies(prefix)("userface")
		end if		
	end function
	'写入session
	
	sub setsession(byval strs,byval val)
		if issession=2 then 
			session(prefix&strs)=val
			setcookie strs,val
		elseif issession=1	then
			setcookie strs,val
		else
			session(prefix&strs)=val
		end if
	end sub
	
	'读取session
	function getsession(byval strs)
		if issession=0 then 
			getsession=session(prefix&strs)		
		elseif  issession=1 then 
			getsession=getcookie(strs)
		else
			getsession=session(prefix&strs)
			if isnul(getsession) then 	getsession=getcookie(strs)
		end if		
	end function
	
	sub gotoerr(id,title,val,desc)
		setcookie "errid",id
		setcookie "errtitle",title
		setcookie "errval",val
		setcookie "errdesc",desc
		jsgo(sitepath&"error404.asp")
	end sub
	
	sub goto404(byval val)
		setcookie "errid","404"
		setcookie "errtitle",val
		setcookie "errval","您访问的页面不存在或存在错误"
		setcookie "errdesc","请联系管理员，或返回首页"
		jsgo(sitepath&"error404.asp")
	end sub
	'文件类开始
	
	'日期加四位随机数，用作文件夹图片名称
	function getrndname()
		dim rndstr,nowdate
		randomize
		nowdate=now()
		rndstr=int(900*rnd)+100
		getrndname=year(nowdate)&month(nowdate)&day(nowdate)&hour(nowdate)&minute(nowdate)&second(rndstr)&rndstr
	end function	
	
	sub errlog(byval strs,byval t1)
		if strs="" then exit sub
		dim userid,username
		userid=getsession("adminid")
		if isnul(userid) then
			userid=getsession("uid")	:	if isnul(userid) then userid=0
			username=getsession("username")
		else
			username=getsession("adminName") 
		end if
		 conn.exec "insert into [dbpre]log_err (Lid,userid,username,ip,addtime,content)values("&zset.LID&","&userid&",'"&username&"','"&getip()&"','"&now()&"','"&enhtml(strs)&"')","exe"
		if t1="" then echo "发生系统错误，系统已记录。" else echo strs
	end sub
	

	function sendmail(byval mailto,byval title,byval mailbody)
		dim i
		sendmail=false		
		if mailto="" or instr(mailto,"@") = 0 then sendmail=false	:	exit function
		if instr(mailto,",") > 0	then
			for i=0 To ubound(split(mailto,","))
				if sendmailing(split(mailto,",")(i),title,mailbody) then
					sendmail=true
				end if
			next
		else
			sendmailing mailto,title,mailbody
			if err then sendmail=false		
		end if
	end function
	
	function sendmailing(byval mailto,byval title,byval mailbody)	
		err.clear
		on error resume next
		select case mailtype
			case "":exit function
			case "jmail"
				dim jmail
				set jmail=server.createobject("jmail.message")
				jmail.charset="GB2312"
				jmail.contenttype="text/html"
				jmail.addrecipient mailto					'收件人的E-Mail地址。		
				jmail.subject=title						'主题
				jmail.body=mailbody						'内容
				jmail.from=smtp_usermail				'发件人邮箱
				jmail.mailserverusername=smtp_user		'用户名	
				jmail.mailserverpassword=smtp_password	'密码
				jmail.send(smtp_server)				'发送邮件	
				set jmail=nothing	
				JMail.Close()
				if err then
					sendmailing=false
				else
					sendmailing=true
				end if
				
			case "cdosys"
				dim objmail,objconfig
				set objmail=server.createobject("cdo.message") 
				set objconfig=server.createobject("cdo.configuration") 
				objconfig.fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25 
				objconfig.fields("http://schemas.microsoft.com/cdo/configuration/sendusing")=2 
				objconfig.fields("http://schemas.microsoft.com/cdo/configuration/smtpserver")=smtp_server
				objconfig.fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=1 
				objconfig.fields("http://schemas.microsoft.com/cdo/configuration/sendusername")=smtp_user
				objconfig.fields("http://schemas.microsoft.com/cdo/configuration/sendpassword")=smtp_password
				objconfig.fields("http://schemas.microsoft.com/cdo/configuration/languagecode")="0x0804" 
				objconfig.fields.update() 
				set objmail.configuration=objconfig
				objmail.subject=title
				objmail.from=smtp_usermail
				objmail.to=mailto
				objmail.htmlbody=mailbody
				objmail.send 
				set objmail=nothing
				set objconfig=nothing
				if err then 
					errlog "组件：cdosys，函数：sendmail<br>详情："&err.description,0
					err.clear
					exit function
				else
					sendmailing=true
				end if
		end select
	end function
	
	function smsbalance()
		dim smsurl,sms_data
		if isnul(smsid) or isnul(smspw) then smsbalance=0 : exit function
		if len(smspw)<>32 then smsbalance=0 : exit function
		smsurl="http://sms.10690221.com:9011/hy/m?uid="&smsid&"&auth="&smspw
		if smsmark=0 then
			smsbalance=0
		else
			sms_data=getHTTPPage(smsurl)	
			if 	leftstr(sms_data,1)="-" then
				smsbalance=0
			else
				smsbalance=isnum(sms_data)
			end if	
		end if
	end function
	
	function sendsms(mobile,content)
	dim target,post_data,res,mobile_code,smsurl,sms_data,tempstr,smscode,smsip,dcount,hcount,scount
	smsurl = "http://sms.10690221.com:9011/hy/?uid="&smsid&"&auth="&smspw&"&mobile="&mobile&"&msg="&content&"&expid=0&encode=utf-8"
	smsip=getip()
		if dbType=1 then
			dcount=dbcount("[dbpre]sms","smsip='"&smsip&"' and smsbackinfo='1' and datediff(d,smsaddtime,'"&sqltime&"')=0")
			hcount=dbcount("[dbpre]sms","smsmobile='"&mobile&"' and smsbackinfo='1' and datediff(hh,smsaddtime,'"&sqltime&"')=0")
			scount=dbcount("[dbpre]sms","smsmobile='"&mobile&"' and smsbackinfo='1' and datediff(s,smsaddtime,'"&sqltime&"')<60")
		else
			dcount=dbcount("[dbpre]sms","smsip='"&smsip&"' and smsbackinfo='1' and datediff('d',smsaddtime,'"&sqltime&"')=0")
			hcount=dbcount("[dbpre]sms","smsmobile='"&mobile&"' and smsbackinfo='1' and datediff('h',smsaddtime,'"&sqltime&"')=0")
			scount=dbcount("[dbpre]sms","smsmobile='"&mobile&"' and smsbackinfo='1' and datediff('s',smsaddtime,'"&sqltime&"')<60")
		end if
		if smsmark=0 then
			sendsms="0短信功能未开启"
		elseif dcount>9 then
			sendsms="0同Ip每天最多发送10次短信息"
		elseif hcount>2 then
			sendsms="0同手机每小时最多发送3次短信息"
		elseif scount>0 then
			sendsms="0同手机每分钟最多发送1次短信息"
		else	
		sms_data=getHTTPPage(smsurl)	
		select case sms_data		 
		  case "-1"		:	tempstr="0签权失败"
		  case "-2"		:	tempstr="0未检索到被叫号码"
		  case "-3"		:	tempstr="0被叫号码过多"
		  case "-4"		:	tempstr="0内容未签名"
		  case "-5"		:	tempstr="0内容过长"
		  case "-6"		:	tempstr="0余额不足"
		  case "-7"		:	tempstr="0暂停发送"
		  case "-8"		:	tempstr="0保留"
		  case "-9"		:	tempstr="0定时发送时间格式错误"
		  case "-10"	:	tempstr="0下发内容为空"
		  case "-11"	:	tempstr="0账户无效"
		  case "-12"	:	tempstr="0Ip地址非法"
		  case "-13"	:	tempstr="0操作频率快"
		  case "-14"	:	tempstr="0操作失败"
		  case "-15"	:	tempstr="0拓展码无效"
		  case "-16"	:	tempstr="0取消定时,seqid错误"
		  case "-17"	:	tempstr="0未开通报告"
		  case "-18"	:	tempstr="0暂留"
		  case "-19"	:	tempstr="0未开通上行"
		  case "-20"	:	tempstr="0暂留"
		  case "-21"	:	tempstr="0包含屏蔽词"
		 ' case else 	:	tempstr="0认证错误服务器错误"
		 case else 		:	tempstr="1发送成功"
	  end select	
	end if
	dbsql "insert into [dbpre]sms(smsmobile,smscontent,smsip,smsaddtime,smsbackinfo,smsonoff,smsid,smspw)values('"&mobile&"','"&content&"','"&smsip&"','"&sqltime&"','"&tempstr&"',"&left(tempstr,1)&",'"&smsid&"','"&hidestr(smspw,8)&"')"	
	sendsms=tempstr
	End Function
	
	'判断用户名是否已经被注册
	public function ifnameUsed(byval username)
		dim rs,result,sql	
		sql = "SELECT 1 FROM ["& dbPre &"user] WHERE username='"& username &"'"
		set rs = dbsql(sql)
		if rs.eof then
			result = false
		else
			result = true
		end if
		rs.Close
		set rs=nothing
		ifnameUsed = result
	end function
	
	'判断Email是否已经被注册
	public function ifEmailUsed(byval email)
		dim rs,result,sql	
			sql = "SELECT 1 FROM ["& dbPre &"user] WHERE email='"& email &"'"		
		set rs = dbsql(sql)
		if rs.eof then
			result = false
		else
			result = true
		end if
		rs.Close
		ifEmailUsed = result
	end function
	
	'判断手机是否已经被注册
	public function ifmobileUsed(byval mobile)
		dim rs,result,sql		
			sql = "SELECT 1 FROM ["& dbPre &"user] WHERE mobile='"& mobile &"'"		
		set rs = dbsql(sql)
		if rs.eof then
			result = false
		else
			result = true
		end if
		rs.Close
		ifmobileUsed = result
	end function
	
	'隐藏中间信息
	function hidestr(byval str,num)
		dim i
		if Len(str)>num*2 then
			For i=1 to Len(str)-num*2
			hidestr=hidestr&"*"
			Next
		else
			hidestr="***"
		end if
		hidestr = left(str,num) &hidestr& right(str,num)
	end function
	
	'隐藏邮箱
	function hideEmail(byval str)
		dim i,elen,ename,esufx,anonys
		ename = cLeft(str,"@")
		esufx = cRight(str,"@")
		elen  = int(len(ename)/3)
		for i=1 to (len(ename)-elen-elen-1)
			anonys = anonys &"*"
		next
		hideEmail = left(ename,elen+1) & anonys & right(ename,elen) &"@"& esufx
	end function
	
	'字符串转换十六进制
	Function StrToNum(str)
		dim i
		For i=1 to Len(str)
		StrToNum = StrToNum & Right("00"& Hex(Ascw(Mid(str,i,2))),4)
		Next
	End Function
	'十六进制转换成字符串
	Function NumToStr(num)
		dim i
		For i=1 to Len(num) Step 4
		NumToStr = NumToStr & Chrw("&H" & Mid(num,i,4))
		Next
	End Function 
	
	const BASE_64_MAP_INIT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
      dim newline
   dim Base64EncMap(63)
   dim Base64DecMap(127)
   '初始化函数
   PUBLIC SUB initCodecs()
     ' 初始化变量
     newline = "<P>" & chr(13) & chr(10)
     dim max, idx
       max = len(BASE_64_MAP_INIT)
     for idx = 0 to max - 1
        Base64EncMap(idx) = mid(BASE_64_MAP_INIT, idx + 1, 1)
     next
     for idx = 0 to max - 1
        Base64DecMap(ASC(Base64EncMap(idx))) = idx
     next
   END SUB
   
	PUBLIC FUNCTION base64Encode(plain)
	call initCodecs
     if len(plain) = 0 then
        base64Encode = ""
        exit function
     end if
     dim ret, ndx, by3, first, second, third
     by3 = (len(plain) \ 3) * 3
     ndx = 1
     do while ndx <= by3
        first = asc(mid(plain, ndx+0, 1))
        second = asc(mid(plain, ndx+1, 1))
        third = asc(mid(plain, ndx+2, 1))
        ret = ret & Base64EncMap( (first \ 4) AND 63 )
        ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second \ 16) AND 15 ) )
        ret = ret & Base64EncMap( ((second * 4) AND 60) + ((third \ 64) AND 3 ) )
        ret = ret & Base64EncMap( third AND 63)
        ndx = ndx + 3
     loop
     if by3 < len(plain) then
        first = asc(mid(plain, ndx+0, 1))
        ret = ret & Base64EncMap( (first \ 4) AND 63 )
        if (len(plain) MOD 3 ) = 2 then
          second = asc(mid(plain, ndx+1, 1))
          ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second \ 16) AND 15 ) )
          ret = ret & Base64EncMap( ((second * 4) AND 60) )
        else
          ret = ret & Base64EncMap( (first * 16) AND 48)
          ret = ret '& "="
        end if
        ret = ret '& "="
     end if
     base64Encode = ret
   END FUNCTION
   
   PUBLIC FUNCTION base64Decode(scrambled)
   call initCodecs
     if len(scrambled) = 0 then
        base64Decode = ""
        exit function
     end if
     dim realLen
     realLen = len(scrambled)
     do while mid(scrambled, realLen, 1) = "="
        realLen = realLen - 1
     loop
     dim ret, ndx, by4, first, second, third, fourth
     ret = ""
     by4 = (realLen \ 4) * 4
     ndx = 1
     do while ndx <= by4
        first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))
        second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))
        third = Base64DecMap(asc(mid(scrambled, ndx+2, 1)))
        fourth = Base64DecMap(asc(mid(scrambled, ndx+3, 1)))
        ret = ret & chr( ((first * 4) AND 255) +  ((second \ 16) AND 3))
        ret = ret & chr( ((second * 16) AND 255) + ((third \ 4) AND 15))
        ret = ret & chr( ((third * 64) AND 255) + (fourth AND 63))
        ndx = ndx + 4
     loop
     if ndx < realLen then
        first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))
        second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))
        ret = ret & chr( ((first * 4) AND 255) +  ((second \ 16) AND 3))
        if realLen MOD 4 = 3 then
          third = Base64DecMap(asc(mid(scrambled,ndx+2,1)))
          ret = ret & chr( ((second * 16) AND 255) + ((third \ 4) AND 15))
        end if
     end if
     base64Decode = ret
   END FUNCTION
			
	Public Function regExpReplace(contentstr,patternstr,replacestr)
		reg.Pattern=patternstr		
		regExpReplace=reg.replace(contentstr,replacestr)		
	End Function
	
	'Addconfigstraras(参数名,正则,参数文件,类型)
	Function AddParas(p,t,c,e)
		dim endTag,isString,val
		isString = ( t = "(\S*?)" )	
		val = enhtml(getForm(p,"post"))		
		endTag = "%" & ">"
		if instr(c,"Const "&p&"") = 0 then	
			c = replace(c,endTag,"")
			c = c & vbCrLf & vbCrLf
			if isString then
				c = c & "Const "&p&"="""&val&""""
			else
				if val = "" then val = 0
				c = c & "Const "&p&"="&val&""
			end if
			c = c & vbCrLf & vbCrLf & endTag
		else	
			if isString then
				if e then
					c=regExpReplace(c,"Const "&p&"="""&t&"""","Const "&p&"="""&encode(val)&"""")
				else			
					c=regExpReplace(c,"Const "&p&"="""&t&"""","Const "&p&"="""&val&"""")
				end if	
			elseif t="num" then
				c=regExpReplace(c,"Const "&p&"=(\d?)","Const "&p&"="&e)
			elseif t="str" then
				c=regExpReplace(c,"Const "&p&"=""(\S*?)""","Const "&p&"="""&e&"""")
			else
				if val = "" then val = 0	
				c=regExpReplace(c,"Const "&p&"="&t,"Const "&p&"="&val)
			end if
		end if
	
		AddParas = c
	End Function
	
	Public Function parseArr(Byval attr)
		on error resume next
		dim ms,attrArray,attrDictionary,i,attrKey,attrValue,dic
		set dic = server.createObject( "Scripting.Dictionary")
		ms = regExpReplace(attr,"[\s]+",chr(32))
		ms = trim(ms)
		attrArray = split(ms,chr(32))
		for i=0 to ubound(attrArray)
			attr = split(attrArray(i),chr(61))
			attrKey =  attr(0) : attrValue =  attr(1)
			if not dic.Exists(attrKey) then dic.add attrKey,attrValue else dic(attrKey) = attrValue
		next
		set ms = nothing
		set parseArr = dic
		set dic = nothing
	End Function

	'获取当前页面URL
	'getURL("")              http://www.kelvinvt.com/news/index.asp?action=news&page=1&user=phenex  (包括端口和参数)
	'getURL(0)               /news/index.asp
	'getURL(1)               /news/index.asp?action=news&page=1&user=phenex
	'getURL(2)               /news/
	'getURL("action")        http://www.kelvinvt.com/news/index.asp?action=news
	'getURL("action,type")   http://www.kelvinvt.com/news/index.asp?action=news&type=
	'getURL("-action,-page") http://www.kelvinvt.com/news/index.asp?user=phenex
	function getURL(byval t)		
		dim u,i,h,d,p,su,dir,par,QSItem,para,arr,param,lencount
		on error resume next
		if lcase(request.serverVariables("HTTPS"))="off" then h = "http://" : else : h = "https://" : end if
		d = request.serverVariables("SERVER_NAME")
		if request.serverVariables("SERVER_PORT")<>80 then p = ":"& request.serverVariables("SERVER_PORT")
		su  = request.serverVariables("URL")
		dir = left(su,instrRev(su,"/"))
		if trim(request.queryString)<>"" then
			para = trim(request.queryString)
			if ifstrin(para,".") then para=split(para,".")(0)
		else
			para = ""
		end if
		if instr(para,"&") > 0 then para=split(para,"&")(0)
		if wapmark then
			if ifstrin(para,"/") then para=split(para,"/")(1)	
		 end if	
		if trim(t)<>"" then
			t=cstr(t)
			select case t
				case "0"
					u = su
				case "1"
					u = su & para
				case "2"
					u = dir
				case "3"
					u=para
				case "SID"					
					if isnum(para)=0 then  getURL=0 :	exit function
					if ifstrin(para,"list_")  then sid=split(para,"list_")(1) else sid=para	
					if ifstrin(para,"|")  then
						lencount=len(para)-len(replace(para,"|",""))
						SID=split(para,"|")(lencount)
					end if
					if ifstrin(SID,"_")  then
						u=split(SID,"_")(0)
					else
						if isnul(u) or not ifnum(u) then u=0
					end if
					u = isnum(u)
				case "page"
					if isnum(para)=0 then  getURL=1 :	exit function
					dim pages,page,j
					pages=split(para,"_")					
					if Location="content" then					
						if ubound(pages)>1 then u=pages(2)
					else
						u=pages(ubound(pages))
					end if					
					u = isnum(u)
				case "id"
					if isnum(para)=0 then  getURL=0 :	exit function
					if instr(para,"_") > 0 then
						if Location="brand" then 
						u=split(para,"_")(0)	
						else		
						u=split(para,"_")(1)
						end if
					else
						u=para
					end if
					u = isnum(u) 
				case "arr"
					u= trim(request.queryString)
					if instr(u,"|/") > 0 then
						u=split(u,"|/")(0)&"|/"
					else
						u=""
					end if
				case "wap"
					if sitepath<>"/" then su=replace(su,sitepath,"")
					u =replacestr(replacestr(sitepath&"wap/"&su &"?"& para,"index.asp",""),"//","/")
				case else					
					u =replacestr(para,fileExt,"")					
					if (regTest(u,""&t&"=")) then
						u=split(u,""&t&"=")(1)
						u=cleft(cleft(u,"_"),"-")
					end if	
			end select
		else
			u=h & d & p & su & para
		end if
		getURL = iif(isnul(u),0,u)
	end function
	
	function gzip(byval s)
	if isgzip=1 then
			reg.ignorecase = true
			reg.global = true
			reg.pattern="<!--(.+?)-->"  : s = reg.replace(s,"")
			reg.pattern=" +"  : s = reg.replace(s,chr(32))
			reg.pattern="\t+|\r+|\n+" : s = reg.replace(s,"")
			reg.pattern="\r+" : s = reg.replace(s,"")
			reg.pattern="\n+" : s = reg.replace(s,"")
		set reg = nothing
	end if
		s=s&"<span style='display: none;'>Po"&"wer"&"ed b"&"y <a hr"&"ef='h"&"t"&"tp:"&"/"&"/"&"w"&"w"&"w."&"k"&"e"&"lv"&"i"&"n"&"v"&"t"&".c"&"om'>K"&"C"&"M"&"S</a></span>"
		gzip = s
	end function	
		
	function getsplitlink(url,title,types)
		dim i,j,urls,titles,picstrs,filestrs
		if isnul(url) then getsplitlink="" : exit function
		if ifstrin(url,",") then
			urls=split(url,",")
			titles=split(title&",",",")
			for i=0 to ubound(urls)
			    if ubound(titles)>=i then j=i
				picstrs=picstrs&"<a href='"&urls(i)&"'  title='"&titles(j)&"' class='pics'><img src='"&urls(i)&"' alt='"&titles(j)&"'><span>"&titles(j)&"</span></a>"
				filestrs=filestrs&"<a href='"&urls(i)&"'  title='"&titles(j)&"' class='files'>"&titles(j)&"</a>"
			next
		else
			picstrs="<a href='"&url&"'  title='"&title&"' class='pics'><img src='"&url&"' alt='"&title&"'><span>"&title&"</span></a>"
			filestrs="<a href='"&url&"'  title='"&title&"' class='files'>"&title&"</a>"
		end if
		if types="pic" then
			getsplitlink=picstrs
		else
			getsplitlink=filestrs
		end if
	end function
	
	Function getSubStrByFromAndEnd(str,startStr,endStr,operType)
		dim location1,location2
		select case operType
			case "start"	:	location1=instr(str,startStr)+len(startStr):location2=len(str)+1
			case "end"		:	location1=1:location2=instr(location1,str,endStr)
			case else		:	location1=instr(str,startStr)+len(startStr):location2=instr(location1,str,endStr)
		end select
		getSubStrByFromAndEnd=mid(str,location1,location2-location1) 
	End Function
	
	function formatSize(tSize)
		if tSize>=1073741824 then
			formatSize=int((tSize/1073741824)*1000)/1000 & " GB"
		elseIf tSize>=1048576 then
			formatSize=int((tSize/1048576)*1000)/1000 & " MB"
		elseIf tSize>=1024 then
			formatSize=int((tSize/1024)*1000)/1000 & " KB"
		else
			formatSize=tSize & "B"
		end if
	end function
	
	Function ParseSizeLimit(byval SizeLimit)
		dim unit,value,multiplier,limit
		If Not isnumeric(SizeLimit) Then
			multiplier = 1
			SizeLimit = ReplaceEx(lcase(SizeLimit),"\s","")
			value = ReplaceEx(SizeLimit,"[^\d]+","")
			if isnumeric(value) then
				value = clng(value)
				if right(SizeLimit,2)="gb" then multiplier = 1073741824
				if right(SizeLimit,2)="mb" then multiplier = 1048576
				if right(SizeLimit,2)="kb" then multiplier = 1024
				limit = value * multiplier
			else
				limit=-1
			end if
		else
			limit = SizeLimit
		End If	
		if limit<-1 then limit=-1
		ParseSizeLimit = limit
	End Function
	'转换时间
	function formatDate(byval times,byval num)
		on error resume next
		if isnul(times) then exit function
		dim yyyy,mm,dd,hh,mn,ss
		if not isDate(times) then
			if ifnum(times) and len(times)=8 then
				if left(times,4)>1900 then
					times=left(times,4)&"-"&mid(times,5,2)&"-"&mid(times,7,2)
				else
					formatDate=times : exit function
				end if
			else
				formatDate=times : exit function
			end if
		end if
		'**
		times    = cdate(times)
		yyyy = year(times)
		mm   = month(times)
		dd   = day(times)
		hh   = hour(times)
		mn   = minute(times)
		ss   = second(times)
		if mm<10 then mm = 0 & mm
		if dd<10 then dd = 0 & dd
		if hh<10 then hh = 0 & hh
		if mn<10 then mn = 0 & mn
		if ss<10 then ss = 0 & ss
		select case num
			case "0","all","yyyy-mm-dd hh:mn:ss"
			   times = yyyy &"-"& mm &"-"& dd &" "& hh &":"& mn &":"& ss
			case "1","yy/m/d","y/m/d"
			   times = yyyy&"/"&mm&"/"&dd&""
			case "2","yy-m-d","y-m-d"
			   times = yyyy &"-"& mm &"-"& dd
			case "3","上午/下午 hh:mm:ss","上午/下午 hh:mn:ss"
			   if cint(hh)<12 then
				   times = "上午 "& hh &":"& mn &":"& ss
			   elseif cint(hh)=12 then
				   times = "下午 "& hh &":"& mn &":"& ss
			   else
				   hh=cint(hh)-12
				   if len(hh)=1 then hh=0&hh
				   times = "下午 "& hh &":"& mn &":"& ss
			   end if
			case "4","hh:mm:ss","h:m:s"
			   times = hh&":"& mn &":"& ss
			case "5","yyyy"
			   times = yyyy
			case "6","mm"
			   times = mm
			case "7","dd"
			   times = dd
			case "8","m-d"
			   times = mm&"-"&dd
			case "9","yyyymmddhhmnss"
			   times = yyyy&mm&dd& hh & mn & ss
			case "10","hh"
			   times = hh
			case "11","mn"
			   times = mn
			case "12","ss"
			   times = ss
			case "13","yy-m","y-m"
			   times = yyyy &"-"& mm
			case "14","enm"
			   times =MonthToEn(mm,0)
			case "15","enmm"
			   times =MonthToEn(mm,1)
			case "16","now"
			   times =DateToNow(yyyy &"-"& mm &"-"& dd &" "& hh &":"& mn &":"& ss)   
			case else
			   times = yyyy&"/"&mm&"/"&dd&""
		end select
		[formatDate] = times
    end function
	
	' 格式化显示时间为几个月,几天前,几小时前,几分钟前,或几秒前
	Function DateToNow(Byval TheDate)
		Dim iSeconds, iMinutes, iHours, iDays	  
		iSeconds = DateDiff("s", TheDate, Now())  'd/h/n/s
		iMinutes = Int(iSeconds/60)
		iHours = Int(iSeconds/3600)
		iDays = Int(iSeconds/86400)
		If iDays > 30 Then
			DateToNow = formatDate(TheDate,1)
		ElseIf iDays > 14 Then
			DateToNow = "2周前"
		ElseIf iDays > 7 Then
			DateToNow = "1周前"
		ElseIf iDays > 1 Then
			DateToNow = iDays & "天前"
		ElseIf iHours > 1 Then
			DateToNow = iHours & "小时前"
		ElseIf iMinutes > 1 Then
			DateToNow = iMinutes & "分钟前"	
		Else
			DateToNow = "刚刚"
		End If
	End Function

	function MonthToEn(byval themonth,byval thetype)
	dim Enmonth
	if thetype = 0 then
		select case themonth
			case "01"
				Enmonth = "Jan"
			case "02"
				Enmonth = "Feb"
			case "03"
				Enmonth = "Mar"
			case "04"
				Enmonth = "Apr"
			case "05"
				Enmonth = "May"
			case "06"
				Enmonth = "June"
			case "07"
				Enmonth = "July"
			case "08"
				Enmonth = "Aug"
			case "09"
				Enmonth = "Sept"
			case "10"
				Enmonth = "Oct"
			case "11"
				Enmonth = "Nov"
			case "12"
				Enmonth = "Dec"
			case else
				Enmonth = themonth
		end select
	else 
		select case themonth
			case "01"
				Enmonth = "January"
			case "02"
				Enmonth = "February"
			case "03"
				Enmonth = "March"
			case "04"
				Enmonth = "April"
			case "05"
				Enmonth = "May"
			case "06"
				Enmonth = "June"
			case "07"
				Enmonth = "July"
			case "08"
				Enmonth = "August"
			case "09"
				Enmonth = "September"
			case "10"
				Enmonth = "October"
			case "11"
				Enmonth = "November"
			case "12"
				Enmonth = "December"
			case else
				Enmonth = themonth
		end select
	end if
	MonthToEn = Enmonth
	end function  
%>