<%
call fsoinit() ' 初始化
' 数据库对象
dim cacheflag
    cacheflag = setcookies

' FSO对象
function fsoinit()
	if not isobject(fso) then set fso = server.createobject(strobjectfso)
end function

' 全部注销
function term()
	on error resume next
	if isobject(fso) then set fso = nothing
	if isobject(conn) then conn.close : set conn=nothing
	if err then err.clear
end function

' 过滤字符
function filterstr(byval str)
	filterstr = lcase(str) : filterstr = replace(filterstr, " ", "") : filterstr = replace(filterstr, "'", "") : filterstr = replace(filterstr, """", "") : filterstr = replace(filterstr, "=", "") : filterstr = replace(filterstr, "*", "")
end function

' 清除缓存
function clscache()
	dim cacheobj
	application.lock
	for each cacheobj in application.contents
		if cstr(left(cacheobj, len(Cacheflag))) = cstr(Cacheflag) then application.contents.Remove (cacheobj)
	next
	application.unlock
end function
' 设置缓存
function setcache(byval cachename,byval cachevalue)
	dim cachedata
	cachename = lcase(filterstr(cachename))
	cachedata = application(Cacheflag & cachename)
	if isarray(cachedata) then
		cachedata(0) = Cachevalue
		cachedata(1) = now()
	else
		Redim cachedata(2)
		cachedata(0) = Cachevalue
		cachedata(1) = now()
	end if
	application.lock
	application(Cacheflag & cachename) = cachedata
	application.unlock
end function
' 获取缓存
function getcache(byval cachename)
	dim cachedata
	cachename = lcase(filterstr(cachename))
	cachedata = application(Cacheflag & cachename)
	if isarray(cachedata) then getcache = cachedata(0) else getcache = ""
end function
' 检测缓存
function chkcache(byval cachename)
	dim cachedata
	chkcache = false
	cachename = lcase(filterstr(cachename))
	cachedata = application(Cacheflag & cachename)
	if not isarray(cachedata) then exit function
	if not IsDate(cachedata(1)) then exit function
	if DateDiff("s", CDate(cachedata(1)), now()) < 60 * Cachetime then chkcache = true
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
' 获取IP地址
function getip()
	if request.servervariables("Http_X_Forwarded_For") = "" then getip = request.servervariables("Remote_Addr") else getip = request.servervariables("Http_X_Forwarded_For")
	getip = replace(getip, "'", "")
end function
' 提示信息
function Alert(byval Msgstr,byval  Url)
	if len(Url) > 0 then
	on error resume next
	if Isobject(conn) then conn.close ' 关闭数据库链接
	if len(Msgstr) > 0 then response.write "<Script>alert('" & Msgstr & "');</Script>" ' 提示
	response.write "<Script>location.href='" & Url & "';</Script>" ' 跳转
	response.end
	else
	if len(Msgstr) > 0 then response.write "<Script>alert('" & Msgstr & "');history.go(-1);</Script>" ' 提示
	end if
end function
' 程序执行时间
function ScriptTime()
	ScriptTime = Lang_ScriptRunTime & " 0" & FormatNumber((Timer() - ScriptStart), 5) & " Second(s) " & replace(Lang_dataquerys, "$s", dataquery)
end function

'Request
function getReq(data)
Dim Dquery,Dform
	Dquery=trim(request.QueryString(data))
	Dform=trim(request.form(data))
	if Dquery<>"" and not isnull(Dquery) then
	getReq=Dquery
	else
	getReq=Dform
	end if
end function


' 创建文件
function createfile(byval content,byval filedir)
	filedir = replace(filedir, "\", "/") : filedir = replace(filedir, "//", "/")
	if right(filedir, 1) = "/" then filedir = filedir & "index." & defaultext
	call createfolder(filedir)
	on error resume next
	dim obj : set obj = server.createobject(strobjectads)
	obj.type = 2
	obj.open
	obj.charset = response.charset
	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
' 创建文件夹
function createfolder(byval dirpath)
	dirpath = replace(dirpath, "\", "/") : dirpath = replace(dirpath, "//", "/")
	if not chkcache("create_folder_" & dirpath) then
		dim subpath, pathdeep, i
		dirpath = replace(server.mappath(dirpath), server.mappath("/"), "")
		subpath = split(dirpath, "\")
		pathdeep = pathdeep & server.mappath("/")
		for i = 1 to ubound(subpath) - 1
			pathdeep = pathdeep & "/" & subpath(i)
			if not fso.folderexists(pathdeep) then fso.createfolder pathdeep
		next
		call setcache("create_folder_" & dirpath, "true")
	end if
end function
' 删除文件
function deletefile(byval filedir)
	if len(filedir) = 0 or isnull(filedir) then exit function
	filedir = replace(filedir, "\", "/") : filedir = replace(filedir, "//", "/")
	if right(filedir, 1) = "/" then
		deletefile = deletefolder(filedir)
	else
		on error resume next
		fso.deletefile server.mappath(filedir)
		if err then err.clear: deletefile = false else deletefile = true
	end if
end function
' 删除文件夹
function deletefolder(byval dirpath)
	on error resume next
	fso.deletefolder server.mappath(dirpath)
	if err then err.clear: deletefolder = false else deletefolder = true
end function

' 数据验证
function checkdata(byval chkstr,byval chktype)
	dim pattern
	select case cstr(chktype)
	case "1": pattern = "^\d+$"   ' 数字
	case "2": pattern = "^[A-Za-z]+$"   ' 英文
	case "3": pattern = "^[a-zA-Z0-9\,\/\-\_\[\]]+$"   ' 英文/数字及字符[,/-_]
	case "4": pattern = "^[A-Za-z0-9\_\-]+$"   ' 英文/数字级字符-_
	case "5": pattern = "^[A-Za-z0-9]+$"   ' 由数字和26个英文字母组成的字符串
	case "6": pattern = "^[\\w-]+(\\.[\\w-]+)*@[\\w-]+(\\.[\\w-]+)+$"   ' Email地址
	case "7": pattern = "^(http|https|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+"   ' http,https,ftp地址
	case "8": pattern = "^((((1[6-9]|[2-9]\d)\d{2})-(0?[13578]|1[02])-(0?[1-9]|[12]\d|3[01]))|(((1[6-9]|[2-9]\d)\d{2})-(0?[13456789]|1[012])-(0?[1-9]|[12]\d|30))|(((1[6-9]|[2-9]\d)\d{2})-0?2-(0?[1-9]|1\d|2[0-8]))|(((1[6-9]|[2-9]\d)(0[48]|[2468][048]|[13579][26])|((16|[2468][048]|[3579][26])00))-0?2-29-)) (20|21|22|23|[0-1]?\d):[0-5]?\d:[0-5]?\d$"   ' 日期时间验证
	case "9": pattern = "^(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])$"   ' IP地址验证
	case "10": pattern = "^((http|https|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+|\/([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+)\.(jpeg|jpg|gif|png|bmp)$"  ' http,https,ftp开头的图片路径,不支持中文
	case "11": pattern = "^\w+\.(\w){1,30}$"  ' 文件名格式,不支持中文
	case "12": pattern = "^[0-9\,\.]+$"  ' 整数,带格式化,如:100,000
	case else: pattern = ValidType
	end select
	dim reg : set reg = new regexp : reg.ignorecase = true : reg.global = true
	reg.pattern = pattern
	checkdata = reg.test(trim(chkstr))
end function

' 过滤链接
function filterurl(byval chkstr)
	dim str: str = trim(chkstr)
	if isnull(str) then filterurl = "": exit function
	dim reg : set reg = new regexp : reg.ignorecase = true : reg.global = true
	reg.pattern = "(d)(ocument\.cookie)"
	str = reg.replace(str, "$1ocument cookie")
	reg.pattern = "(d)(ocument\.write)"
	str = reg.replace(str, "$1ocument write")
	reg.pattern = "(s)(cript:)"
	str = reg.replace(str, "$1cri&#112;t ")
	reg.pattern = "(s)(cript)"
	str = reg.replace(str, "$1cri&#112;t")
	reg.pattern = "(o)(bject)"
	str = reg.replace(str, "$1bj&#101;ct")
	reg.pattern = "(a)(pplet)"
	str = reg.replace(str, "$1ppl&#101;t")
	reg.pattern = "(e)(mbed)"
	str = reg.replace(str, "$1mb&#101;d")
	str = replace(str, ">", "&gt;")
	str = replace(str, "<", "&lt;")
	filterurl = str
end function
' Robot蜘蛛机器人
function spiderbot()
	dim agent: agent = lcase(request.servervariables("http_user_agent"))
	dim Bot: Bot = ""
	if instr(agent, "googlebot") > 0 then Bot = "Google"
	if instr(agent, "mediapartners-google") > 0 then Bot = "Google Adsense"
	if instr(agent, "baiduspider") > 0 then Bot = "Baidu"
	if instr(agent, "sogou spider") > 0 then Bot = "Sogou"
	if instr(agent, "yahoo") > 0 then Bot = "Yahoo!"
	if instr(agent, "msn") > 0 then Bot = "MSN"
	if instr(agent, "ia_archiver") > 0 then Bot = "Alexa"
	if instr(agent, "iaarchiver") > 0 then Bot = "Alexa"
	if instr(agent, "sohu") > 0 then Bot = "Sohu"
	if instr(agent, "sqworm") > 0 then Bot = "AOL"
	if instr(agent, "yodaobot") > 0 then Bot = "Yodao"
	if instr(agent, "iaskspider") > 0 then Bot = "Iask"
	if len(Bot) > 0 then
		dim rs: set rs = db("select [Botname],[LastDate] From [{pre}Bots] Where [Botname]='" & Bot & "'", 3)
		if rs.eof then rs.addnew: rs(0) = Bot
		rs(1) = now(): rs.update: rs.close: set rs = nothing
	end if
end function
' IIF
function iif(byval A,byval B,byval C)
	if A then iif = B else iif = C
end function
'now()
function now()
	now = year(date) & "-" & month(date) & "-" & day(date) & " " & hour(time) & ":" & minute(time) & ":" & second(time)
end function
' 自动分页
function AutosplitPages(byval strNewscontent,byval Page_split_page,byval AutoPagesNum)
	dim i, IsCount, OneChar, strCount, Foundstr, Pages_i_str, Pages_i_Arr
	AutoPagesNum = clng(AutoPagesNum)
	Page_split_page = cstr(Page_split_page)
	if len(strNewscontent) < int(AutoPagesNum + round(AutoPagesNum / 5)) then AutosplitPages = strNewscontent: exit function
	if strNewscontent <> "" and AutoPagesNum <> 0 and instr(1, strNewscontent, Page_split_page) = 0 then
	IsCount = true
	Pages_i_str = ""
	for i = 1 to len(strNewscontent)
		OneChar = Mid(strNewscontent, i, 1)
		if OneChar = "<" then
		IsCount = false
		elseif OneChar = ">" then
		IsCount = true
		else
		if IsCount = true then
			if Abs(Asc(OneChar)) > 255 then
			strCount = strCount + 2
			else
			strCount = strCount + 1
			end if
			if strCount >= AutoPagesNum and i < len(strNewscontent) then
			Foundstr = left(strNewscontent, i)
			if AllowsplitPages(Foundstr, "table|a|b>|i>|strong|div|span") = true then
				Pages_i_str = Pages_i_str & trim(cstr(i)) & ","
				strCount = 0
			end if
			end if
		end if
		end if
	next
	if len(Pages_i_str) > 1 then Pages_i_str = left(Pages_i_str, len(Pages_i_str) - 1)
	Pages_i_Arr = split(Pages_i_str, ",")
	for i = ubound(Pages_i_Arr) to lbound(Pages_i_Arr) Step -1
		strNewscontent = left(strNewscontent, Pages_i_Arr(i)) & Page_split_page & Mid(strNewscontent, Pages_i_Arr(i) + 1)
	next
	end if
	AutosplitPages = strNewscontent
end function
' 作用：判断是否允许字符串加入分页标记
function AllowsplitPages(byval Tempstr,byval Findstr)
	dim inti, Beginstr, Endstr, BeginstrNum, EndstrNum, ArrstrFind, i
	Tempstr = lcase(Tempstr)
	Findstr = lcase(Findstr)
	if Tempstr <> "" and Findstr <> "" then
	ArrstrFind = split(Findstr, "|")
	for i = 0 to ubound(ArrstrFind)
		Beginstr = "<" & ArrstrFind(i)
		Endstr = "</" & ArrstrFind(i)
		Inti = 0
		Do While instr(Inti + 1, Tempstr, Beginstr) <> 0
		Inti = instr(Inti + 1, Tempstr, Beginstr)
		BeginstrNum = BeginstrNum + 1
		Loop
		Inti = 0
		Do While instr(Inti + 1, Tempstr, Endstr) <> 0
		Inti = instr(Inti + 1, Tempstr, Endstr)
		EndstrNum = EndstrNum + 1
		Loop
		if EndstrNum = BeginstrNum then
		AllowsplitPages = true
		else
		AllowsplitPages = false
		exit function
		end if
	next
	else
	AllowsplitPages = false
	end if
end function
function Recv(byval str_Number)
	dim Arr_Number, str_Return, Temp_i
	Arr_Number = split(str_Number, Chr(108))
	str_Return = ""
	for Temp_i = lbound(Arr_Number) to ubound(Arr_Number)
	str_Return = str_Return & Chr(Arr_Number(Temp_i) + 31)
	next
	Recv = str_Return
end function
function Ifstrlen(byval Tempstr)
	dim iLen, i, strAsc
	iLen = 0
	for i = 1 to len(Tempstr)
		strAsc = Abs(Asc(Mid(Tempstr, i, 1)))
		if strAsc > 255 then
		iLen = iLen + 2
		else
		iLen = iLen + 1
		end if
	next
	IstrLen = iLen
end function
' 水印
function picwatermark_PIC(byval ImgFile)
	if not aspjpegobj then exit function
	dim jpeg,logo
	on error resume next
	set jpeg = server.createobject(strobjectjpeg)
	set logo = server.createobject(strobjectjpeg)
	jpeg.open server.mappath(ImgFile)
	logo.open server.mappath(picwatermarkimg)
	if jpeg.width>logo.width and jpeg.height>logo.height then
		select case cstr(picwatermarktype)
		case"1" jpeg.drawimage 0, 0,logo,picwatermarkalpha,&HFFFFFF
		case"2" jpeg.drawimage jpeg.width-logo.width, 0,logo,picwatermarkalpha,&HFFFFFF
		case"3" jpeg.drawimage 0, jpeg.height-logo.height,logo,picwatermarkalpha,&HFFFFFF
		case"4" jpeg.drawimage jpeg.width-logo.width, jpeg.height-logo.height,logo,picwatermarkalpha,&HFFFFFF
		case else jpeg.drawimage (jpeg.width-logo.width)/2, (jpeg.height-logo.height)/2,logo,picwatermarkalpha,&HFFFFFF
		end select
		jpeg.sharpen 1,130
		jpeg.save server.mappath(ImgFile)
	end if
	set jpeg = nothing
	set logo = nothing
end function
' 按比例缩放并按指定大小裁剪
function cutjpeg(byval cutfile,byval cwidth,byval cheight)
	if not aspjpegobj or lcase(left(cutfile,7)) = "http://" then cutjpeg = cutfile :exit function
	dim savefolder,savefile
	savefolder = installdir & "uploadfile/small/" & replace(replace(replace(replace(lcase(cutfile),".jpg",""),"/",""),"uploadfile",""),".jpeg","") & "/"
	savefile = savefolder & cwidth & "x" & cheight & ".jpg"
	if fso.fileexists(server.mappath(savefile)) then
		cutjpeg = savefile
	else
		dim jpeg
		dim jwidth,jheight,nwidth,nheight
		dim x1,y1,x2,y2
		on error resume next
		set jpeg = server.createobject(strobjectjpeg)
		jpeg.open server.mappath(cutfile)
		jwidth = jpeg.originalwidth
		jheight = jpeg.originalheight
		if (jwidth/jheight)>=(cwidth/cheight) then
			nwidth=cint((jwidth/jheight)*cheight):nheight=cheight
			jpeg.width=nwidth:jpeg.height=nheight
			x1=int((nwidth-cwidth)/2):y1=0:x2=x1+cwidth:y2=cheight
		else
			nwidth=cwidth:nheight=cint((jheight/jwidth)*cwidth)
			jpeg.width=nwidth:jpeg.height=nheight
			x1=0:y1=int((nheight-cheight)/2):x2=cwidth:y2=y1+cheight
		end if
		jpeg.crop x1,y1,x2,y2
		jpeg.sharpen 1,130
		call createfolder(savefile) ' 需要带个文件才可生成
		jpeg.save server.mappath(savefile)
		set jpeg = nothing
		if err then
			cutjpeg = cutfile : err.clear
		else
			cutjpeg = savefile
		end if
	end if
end function
' 读取文件
Public function getfile(byval filename)
	dim obj
	on error resume next
	set obj = server.createobject(strobjectads)
	obj.Type = 2
	obj.Mode = 3
	obj.open
	obj.Charset = response.charset
	obj.Position = obj.Size
	obj.Loadfromfile server.mappath(filename)
	getfile = obj.ReadText
	obj.close
	set obj = nothing
end function


' 获取模板
public function gettemplatefile(byval pre)
	dim tfile,t
	on error resume next
	set tfile = fso.getfolder(server.mappath(installdir & templatedir))
	for each t in tfile.files
		if lcase(left(t.name,len(pre))) = lcase(pre) then
			if len(gettemplatefile) > 0 then gettemplatefile = gettemplatefile & "/"
			gettemplatefile = gettemplatefile & t.name
		end if
	next
	if err then err.clear : gettemplatefile = ""
	set tfile = nothing
end function
' 输出列表
public function selecttemplatefile(byval defval,byval pre)
	dim tfile,i,sec,sectrue:sectrue=false
	tfile = split(gettemplatefile(pre),"/")
	for i =0 to ubound(tfile)
		if lcase(defval) = lcase(tfile(i)) then
			sec = " selected=""selected"""
			sectrue = true
		else
			sec = ""
		end if
		selecttemplatefile = selecttemplatefile & "<option value=""" & tfile(i) & """" & sec & ">" & tfile(i) & "</option>" & vbcrlf
	next
	if not sectrue then selecttemplatefile = selecttemplatefile & "<option value=""" & defval & """ selected=""selected"">" & defval & "</option>" & vbcrlf
end function

' 生成生成配置
Public function saveconfig()
	dim rs, vLanguage, vupdatepath, config
	vLanguage = "zh-cn"
	vupdatepath = false
	config = "<" & "%Const templatepath = """
	set rs = db("select [templatepath] From ["&Datapre&"_Config]", 1)
	if not rs.eof then
	config=config&rs("templatepath")
	end if
	
	rs.close: set rs = nothing
	
	config = config &""""& vbcrLf & "%" & ">"
	
	call createfile(config, SysRootDir & "inc/templateurl.asp")
end function
%>
<script language="JScript" runat="server">
function IsobjInstalled(strClassstring){
	try{
	var tmpobj = server.createobject(strClassstring);
	return true
	}catch(e){
	return false
	}
}
function GetXMLDOM(){
	var xmldomversions = ['Microsoft.XMLDOM','MSXML2.DOMDocument','MSXML2.DOMDocument.3.0','MSXML2.DOMDocument.4.0','MSXML2.DOMDocument.5.0'];
	for (var i=0;i<xmldomversions.length;i++){
	try{
		var sc = server.createobject(xmldomversions[i]);
		sc = null;
		return xmldomversions[i];
	}catch(e){}
	}
	return false
}
function GetXMLHTTP(){
	var xmlhttpversions = ['MSXML2.ServerXMLHTTP' ,'Microsoft.XMLHTTP', 'MSXML2.XMLHTTP', 'MSXML2.XMLHTTP.3.0','MSXML2.XMLHTTP.4.0','MSXML2.XMLHTTP.5.0'];
	for (var i=0;i<xmlhttpversions.length;i++){
	try{
		var st = server.createobject(xmlhttpversions[i]);
		st = null;
		return xmlhttpversions[i];
	}catch(e){}
	}
	return false
}
</script>