⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 setup.asp

📁 采用的是新云内核
💻 ASP
📖 第 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,AdminDataCount
LoadXslAdminSetting

Dim AdminSkin
AdminSkin = Newasp.ChkNumeric(Request.Cookies("newasp_admin_skin"))
If AdminSkin = 0 Then
	AdminSkin = DefaultAdminSkin
End If

Dim Rs,SQL,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
	On Error Resume Next
	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)
	On Error Resume Next
	Set XslDoc = Server.CreateObject("Msxml2.FreeThreadedDOMDocument" & MsxmlVersion)
	If Not XslDoc.Load(Xsl_Files) Then
		DefaultAdminSkin		= 1
		UseAdminCookies			= True
		Admin_Cookies_Name		= "newasp_admin"
		IsAdminValidate			= false
		AdminValidateCode		= "admin123"
		AdminLogstop			= 1
		LockIPList			= ""
		CheckIPType			= 0
		AdminTimer			= 0
		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"
		AdminDataCount			= 0
	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"))
		AdminDataCount			= Newasp.ChkNumeric(XslNode.getAttribute("datacount"))
		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)
	If Not stylesheet.load(Server.MapPath("include\GetAdminagent.xslt")) Then Exit Sub
	
	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
	If Err.Number <> 0 Then Err.Clear
End Sub

Function CreateXMLSiteMap(FilePath,sXML)
	If InStr(FilePath, ":") = 0 Then FilePath = Server.MapPath(FilePath)
	Dim oStream
	On Error Resume Next
	Set oStream = Server.CreateObject(SERVER_OBJECT_NAME(1))
	With oStream
		.Type = 2 '设置为可读可写
		.Mode = 3 '设置内容为文本
		.Charset = "UTF-8"
		.Open
		.Position = oStream.Size
		.WriteText sXML
		.SaveToFile FilePath, 2
		.Close
	End With
	Set oStream = Nothing
	If Err.Number <> 0 Then Err.Clear
End Function 

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 ",'"

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -