setup.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 417 行 · 第 1/2 页

<!--#include file="../conn.asp" -->
<!--#include file="../inc/const.asp"-->
<%
dim defaultadminskin,useadmincookies,admin_cookies_name,isadminvalidate,adminvalidatecode,adminlogstop
dim lockiplist,checkiptype,admintimer,timersetting,timesetting
loadxsladminsetting

dim adminskin
adminskin = newasp.chknumeric(request.cookies("newasp_admin_skin"))
if adminskin = 0 then
	adminskin = defaultadminskin
end if

dim lconn
dim founderr,errmsg,sucmsg,adminpage
founderr = false
adminpage = false

'session.timeout = sessiontimeout
sub connectionlogdatabase()
	on error resume next
	dim lconnstr
	lconnstr = "provider=microsoft.jet.oledb.4.0;data source=" & server.mappath("logdata.asa")
	set lconn = server.createobject("adodb.connection")
	lconn.open lconnstr
	if err then
		err.clear
		set lconn = nothing
		response.end
	end if
end sub

sub saveloginfo(lname)
	dim requeststr
	dim lsql,istoplog
	istoplog = adminlogstop      '是否停止日志,1=停止,0=启用
	if istoplog = 1 then exit sub
	connectionlogdatabase
	if instr(newasp.scriptname, "_index") > 0 or instr(newasp.scriptname, "admin_log") > 0 then exit sub
	lname = newasp.checkstr(lname) 
	requeststr = lcase(request.servervariables("query_string"))
	if requeststr <> "" then 
		requeststr=newasp.checkstr(requeststr)
		requeststr=left(requeststr,250)
		lsql = "insert into [nc_loginfo] (username,userip,scriptname,actcontent,logaddtime,logtype) values ('"& lname &"','"& newasp.getuserip &"','"& newasp.scriptname &"','"& requeststr &"','"& now() &"',0)"		
		lconn.execute(lsql)
	end if
	if request.form <> "" then
		requeststr = newasp.checkstr(request.form)
		requeststr = left(requeststr,250)
		lsql = "insert into [nc_loginfo] (username,userip,scriptname,actcontent,logaddtime,logtype) values ('"& lname &"','"& newasp.getuserip &"','"& newasp.scriptname &"','"& requeststr &"','"& now() &"',1)"		
		lconn.execute(lsql)
	end if
	if isobject(lconn) and not lconn is nothing then
		lconn.close
		set lconn = nothing
	end if
end sub

sub loadxsladminsetting()
	dim xsldoc,xslnode,xsl_files
	xsl_files = "include/admin.config"
	xsl_files = server.mappath(xsl_files)
	set xsldoc = server.createobject("msxml2.freethreadeddomdocument" & msxmlversion)
	if not xsldoc.load(xsl_files) then
		response.write "初始数据不存在！"
		response.end
	else
		set xslnode				= xsldoc.documentelement.selectsinglenode("rs:data/z:row")
		defaultadminskin		= newasp.chknumeric(xslnode.getattribute("defaultadminskin"))
		useadmincookies			= newasp.chkboolean(xslnode.getattribute("admincookies"))
		admin_cookies_name		= trim(xslnode.getattribute("admincookiesname"))
		isadminvalidate			= newasp.chkboolean(xslnode.getattribute("adminvalidate"))
		adminvalidatecode		= xslnode.getattribute("adminvalidatecode")
		adminlogstop			= newasp.chknumeric(xslnode.getattribute("adminlogstop"))
		lockiplist				= trim(xslnode.getattribute("lockiplist"))
		checkiptype				= newasp.chknumeric(xslnode.getattribute("checkiptype"))
		admintimer				= newasp.chknumeric(xslnode.getattribute("admintimer"))
		timersetting			= trim(xslnode.getattribute("timersetting"))
		set xslnode = nothing
	end if
	set xsldoc = nothing
	if len(timersetting)< 24 then timersetting="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
	timesetting = split(timersetting,"|")
end sub

sub checkadminip()
	dim xmldom,node
	dim i,locklist,ip,ip1
	dim agent,xsltemplate,proc
	dim stylesheet,strprocxml
	dim islockip,m_strip
	'--打开后台定时功能
	if admintimer = 1 then
		if timesetting(hour(now))="1" then
			set newasp = nothing
			errmsg = "<li>后台管理暂时关闭，不能登陆!</li><li>如果要登陆后台，请联系本站管理员。</li>"
			response.redirect ("showerr.asp?action=error&message=" & server.urlencode(errmsg) & "")
		end if
	end if

	if len(lockiplist) < 7 then exit sub
	on error resume next
	
	set xmldom=server.createobject("msxml2.freethreadeddomdocument"& msxmlversion)
	xmldom.appendchild(xmldom.createelement("xml"))
	locklist=trim(lockiplist)
	locklist=split(locklist,"|")
	for each ip in locklist
		ip1=split(ip,".")
		set node=xmldom.documentelement.appendchild(xmldom.createnode(1,"lockip",""))
		for i=0 to ubound(ip1)
			node.attributes.setnameditem(xmldom.createnode(2,"number"& (i+1),"")).text=ip1(i)
		next
		set node=nothing
	next
	
	set agent=xmldom.clonenode(true)
	agent.documentelement.attributes.setnameditem(agent.createnode(2,"ip","")).text=newasp.getuserip
	agent.documentelement.attributes.setnameditem(agent.createnode(2,"actforip","")).text=newasp.actforip
	set xmldom=nothing
	
	set stylesheet=server.createobject("msxml2.freethreadeddomdocument"& msxmlversion)
	stylesheet.load server.mappath("include\getadminagent.xslt")
	
	set xsltemplate=server.createobject("msxml2.xsltemplate" & msxmlversion)
	xsltemplate.stylesheet=stylesheet
	set proc = xsltemplate.createprocessor()
	proc.input = agent
	proc.transform()
	strprocxml = proc.output
	set agent=nothing
	set stylesheet=nothing
	set xsltemplate=nothing
	set proc=nothing

	set xmldom=server.createobject("msxml2.freethreadeddomdocument"& msxmlversion)
	'xmldom.appendchild(xmldom.createelement("xml"))
	if not xmldom.loadxml(strprocxml) then exit sub
	if not xmldom.documentelement.selectsinglenode("@lockip") is nothing then
		islockip = xmldom.documentelement.selectsinglenode("@lockip").text
	else
		islockip = "0"
	end if
	if not xmldom.documentelement.selectsinglenode("@ip") is nothing then
		m_strip = xmldom.documentelement.selectsinglenode("@ip").text
	end if
	set xmldom=nothing
	if checkiptype = 0 then
		if islockip = "1" then
			set newasp = nothing
			errmsg = "<li>您ip："&m_strip&" 已被锁定，不能登陆后台!</li><li>如果要登陆后台，请联系本站管理员。</li>"
			response.redirect ("showerr.asp?action=error&message=" & server.urlencode(errmsg) & "")
			response.end
		end if
	else
		if islockip = "0" then
			set newasp = nothing
			errmsg = "<li>您ip："&m_strip&" 已被锁定，不能登陆后台!</li><li>如果要登陆后台，请联系本站管理员。</li>"
			response.redirect ("showerr.asp?action=error&message=" & server.urlencode(errmsg) & "")
			response.end
		end if
	end if
	
end sub

function fixjs(str)
        if str <> "" then
                str = replace(str, "\", "\\")
                str = replace(str, chr(34), "\""")
                str = replace(str, chr(39), "\'")
                str = replace(str, chr(13), "")
                str = replace(str, chr(10), "")
                'str = replace(str,"'", "&#39;")
        end if
        fixjs = str
        exit function
end function
'================================================
'函数名：showlistpage
'作  用：通用分页
'================================================
function showlistpage(currentpage,pcount,totalrec,pagenum,strlink,listname)
	with response
		.write "<script>"
		.write "showlistpage("
		.write currentpage
		.write ","
		.write pcount
		.write ","
		.write totalrec
		.write ","
		.write pagenum
		.write ",'"
		.write strlink
		.write "','"
		.write listname
		.write "');"
		.write "</script>" & vbnewline
	end with
end function
'================================================
'函数名：showpages
'作  用：通用分页
'================================================
function showpages(currentpage,pcount,totalrec,pagenum,str)
	dim strtemp,strrequest
	strrequest = str
	strtemp = "<table border=0 cellpadding=0 cellspacing=3 width=""100%"" align=center>" & vbnewline