www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/adminhtry/setup.asp

    <!--#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 ",'"
		.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
	strTemp = strTemp & "<tr><td valign=middle nowrap>" & vbNewLine
	strTemp = strTemp & "页次:<b><font color=red>" & CurrentPage & "</font></b>/<b>" & Pcount & "</b>页&nbsp;" & vbNewLine
	strTemp = strTemp & "每页<b>" & PageNum & "</b> 总数<b>" & totalrec & "</b></td>" & vbNewLine
	strTemp = strTemp & "<td valign=middle nowrap align=right>分页:" & vbNewLine
	strTemp = strTemp & "<script language=""JavaScript"">" & vbNewLine
	strTemp = strTemp & "<!--" & vbNewLine
	strTemp = strTemp & "var CurrentPage=" & CurrentPage & ";" & vbNewLine
	strTemp = strTemp & "var Pcount=" & Pcount & ";" & vbNewLine
	strTemp = strTemp & "var Endpage=0;" & vbNewLine
	strTemp = strTemp & "if (CurrentPage > 4){" & vbNewLine
	strTemp = strTemp & "	document.write ('<a href=""?page=1" & strRequest & """>[1]</a> ...');" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "if (Pcount>CurrentPage+3)" & vbNewLine
	strTemp = strTemp & "{" & vbNewLine
	strTemp = strTemp & "	Endpage=CurrentPage+3" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "else{" & vbNewLine
	strTemp = strTemp & "	Endpage=Pcount" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "for (var i=CurrentPage-3;i<=Endpage;i++)" & vbNewLine
	strTemp = strTemp & "{" & vbNewLine
	strTemp = strTemp & "	if (i>=1){" & vbNewLine
	strTemp = strTemp & "		if (i == CurrentPage)" & vbNewLine
	strTemp = strTemp & "		{" & vbNewLine
	strTemp = strTemp & "			document.write ('<font color=""#FF0000"">['+i+']</font>');" & vbNewLine
	strTemp = strTemp & "			}" & vbNewLine
	strTemp = strTemp & "		else{" & vbNewLine
	strTemp = strTemp & "			document.write ('<a href=""?page='+i+'" & strRequest & """>['+i+']</a>');" & vbNewLine
	strTemp = strTemp & "		}" & vbNewLine
	strTemp = strTemp & "	}" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "if (CurrentPage+3 < Pcount){" & vbNewLine 
	strTemp = strTemp & "	document.write ('...<a href=""?page='+Pcount+'" & strRequest & """>['+Pcount+']</a>');" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "if (Endpage == 0){ " & vbNewLine
	strTemp = strTemp & "	document.write ('...');" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "//-->" & vbNewLine
	strTemp = strTemp & "</script>" & vbNewLine
	strTemp = strTemp & "</td></tr></table>"
	ShowPages = strTemp
End Function

Public Sub ReturnError(ErrMsg)
	Response.Write "<html><head><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312""><title>错误提示信息!</title>" & vbCrLf
	Response.Write "<meta http-equiv=refresh content=3;url=javascript:history.go(-1)>"
	Response.Write "<link href=""images/css/admin_style_" & AdminSkin & ".css"" rel=""stylesheet"" type=""text/css""></head><body><p>&nbsp;</p>" & vbCrLf
	Response.Write "<table cellpadding=5 cellspacing=0 border=0 align=center class=tableBorder1>" & vbCrLf
	Response.Write "  <tr><th colspan=2 align=""left""><img src=""images/welcome.gif"" width=""16"" height=""17"" align=""absMiddle""> 错误提示信息!</th></tr>" & vbCrLf
	Response.Write "  <tr><td align=center width=""20%"" class=TableRow1><img src=""images/err.gif"" width=95 height=97 border=0></td><td width=""80%"" class=TableRow1><b style=color:blue><span id=jump>3</span> 秒钟后系统将自动返回</b><br><b>产生错误的可能原因:</b><BR>" & ErrMsg & "</td></tr>" & vbCrLf
	Response.Write "  <tr><td colspan=2 align=center height=25 class=TableRow2><a href=javascript:history.go(-1)>返回上一页...</a></td></tr>" & vbCrLf
	Response.Write "</table><p>&nbsp;</p>" & vbCrLf
	Response.Write "</body></html>" & vbCrLf
	Response.Write "<script>function countDown(secs){jump.innerText=secs;if(--secs>0)setTimeout(""countDown(""+secs+"")"",1000);}countDown(3);</script>"
End Sub

Public Sub Succeed(SucMsg)
	Response.Write "<html><head><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312""><title>错误提示信息!</title>" & vbCrLf
	Response.Write "<meta http-equiv=refresh content=5;url=" & Request.ServerVariables("HTTP_REFERER") & ">"
	Response.Write "<link href=""images/css/admin_style_" & AdminSkin & ".css"" rel=""stylesheet"" type=""text/css""></head><body><p>&nbsp;</p>" & vbCrLf
	Response.Write "<table align=""center"" border=""0"" cellpadding=""5"" cellspacing=""0"" class=""tableBorder1"">" & vbCrLf
	Response.Write "    <tr> " & vbCrLf
	Response.Write "      <th colspan=2 align=""left""><img src=""images/welcome.gif"" width=""16"" height=""17"" align=""absMiddle""> 成功提示信息!</th>" & vbCrLf
	Response.Write "    </tr>" & vbCrLf
	Response.Write "  <tr><td align=center width=""20%"" class=TableRow1><img src=""images/succ.gif"" width=95 height=97 border=0></td><td width=""80%"" class=TableRow1>"
	Response.Write " <b style=color:blue><span id=jump>5</span> 秒钟后系统将自动返回</b><br>"
	Response.Write SucMsg & "</td></tr>" & vbCrLf
	Response.Write "  <tr><td colspan=2 align=center height=25 class=TableRow2><a href='" & Request.ServerVariables("HTTP_REFERER") & "'>返回上一页...</a></td></tr>" & vbCrLf
	Response.Write " </table><p>&nbsp;</p>" & vbCrLf
	Response.Write "</body></html>" & vbCrLf
	Response.Write "<script>function countDown(secs){jump.innerText=secs;if(--secs>0)setTimeout(""countDown(""+secs+"")"",1000);}countDown(3);</script>"
End Sub

Public Function ErrAlert(thistr)
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('" & thistr & "');"
	Response.Write "javascript:history.back(1)" & vbCrLf
	Response.Write "</script>" & vbCrLf
	Response.End
End Function

Public Function SucInform(thistr)
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('" & thistr & "');"
	Response.Write "location.replace('" & Request.ServerVariables("HTTP_REFERER") & "')" & vbCrLf
	Response.Write "</script>" & vbCrLf
	Response.End
End Function

Public Function AlertInform(this_str,this_url)
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('" & this_str & "');"
	Response.Write "location.replace('" & this_url & "')" & vbCrLf
	Response.Write "</script>" & vbCrLf
	Response.End
End Function

Public Function CheckAdmin(flag)
	Dim Rs, SQL
	Dim i, TempAdmin, Adminflag,AdminGrade
	CheckAdmin = False
	On Error Resume Next
	SQL ="SELECT id,AdminGrade,Adminflag FROM [NC_Admin] WHERE username='"& Replace(Session("AdminName"), "'", "''") &"' And password='"& Replace(Session("AdminPass"), "'", "''") &"' And isLock=0 And id="& CLng(Session("AdminID"))
	Set Rs = Newasp.Execute(SQL)
	If Rs.BOF And Rs.EOF Then
		CheckAdmin = False
		Set Rs = Nothing
		Exit Function
	Else
		Adminflag = Rs("Adminflag")
		AdminGrade = Rs("AdminGrade")
	End If
	Rs.Close:Set Rs = Nothing
	If CInt(AdminGrade) = 999 Then
		CheckAdmin = True
		Exit Function
	Else
		If Trim(flag) = "" Then Exit Function
		If Adminflag = "" Then
			CheckAdmin = False
			Exit Function
		Else
			tempAdmin = Split(AdminFlag, ",")
			For i = 0 To UBound(tempAdmin)
				If LCase(tempAdmin(i)) = LCase(flag) Then
					CheckAdmin = True
					Exit For
				End If
			Next
		End If
	End If
End Function

Sub Admin_footer()
	Response.Write "<br /><table align=center>" & vbCrLf
	Response.Write "<tr align=center><td width=""100%"" style=""LINE-HEIGHT: 150%"" class=""copyright"">" & vbCrLf        
	If CInt(isSqlDataBase) = 1 Then
			Response.Write " Powered by:<a href=http://www.newasp.net target=_blank>新云网站内容管理系统 Version 3.1.0.1231</a> (MSSQL 版)<br>" & vbCrLf
	Else
			Response.Write " Powered by:<a href=http://www.newasp.net target=_blank>新云网站内容管理系统 Version 3.1.0.1231</a> (ACCESS 版)<br>" & vbCrLf
	End If
	Response.Write Newasp.Copyright & vbCrLf

	If CInt(Newasp.IsRunTime) = 1 Then
			Dim Endtime
			Endtime = Timer()
			Response.Write "<BR>执行时间:" & FormatNumber(Endtime - startime,5, -1) & "毫秒。查询数据库" & Newasp.SqlQueryNum & "次。" & vbCrLf
			'Response.Write "<li>共使用了" & Application.Contents.Count & "个缓存对象。</li>"
	End If
	Response.Write "</td>" & vbCrLf
	Response.Write "</tr>" & vbCrLf
	Response.Write "</table>" & vbCrLf
	Response.Write "</body></html>"
End Sub

Sub Admin_header()
	'Response.Write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">" & vbCrLf
	Response.Write "<html>" & vbCrLf
	Response.Write "<head>" & vbCrLf
	Response.Write Newasp.CopyrightStr
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbCrLf
	Response.Write "<title>" & Newasp.SiteName & "-管理页面</title>" & vbCrLf
	Response.Write "<link href=""images/css/admin_style_" & AdminSkin & ".css"" type=""text/css"" rel=""stylesheet"">" & vbCrLf
	Response.Write "<script src=""include/admin.js"" type=""text/javascript""></script>" & vbCrLf
	Response.Write "<base target=""_self"">" & vbNewLine
	Response.Write "</head>" & vbCrLf
	Response.Write "<body leftmargin=""0"" bottommargin=""0"" rightmargin=""0"" topmargin=""0"">" & vbCrLf
	Response.Write "<br style=""overflow: hidden; line-height: 3px"" />" & vbCrLf
End Sub
Public Sub ScriptCreation(url,id)
	Response.Write "<span id='showimport" & id & "'></span>"
	Response.Write "<script>"
	Response.Write "function CreationDone(str){"
	Response.Write "	showimport" & id & ".innerHTML = str;"
	Response.Write "}"
	Response.Write "CreationID.startDownload('" & url & "',CreationDone)"
	Response.Write "</script>" & vbCrLf
End Sub
'================================================
'函数名:Formatime
'作  用:格式化时间
'================================================
Public Function Formatime(ByVal datime)
	datime = Trim(Replace(Trim(datime), vbNewLine, ""))
	If Not IsDate(datime) Then
		Formatime = Now()
		Exit Function
	End If
	If Len(datime) < 11 Then
		Formatime = CDate(datime & " " & FormatDateTime(Now, 3))
	Else
		Formatime = CDate(datime)
	End If
	Exit Function
End Function

Public Function Re_Replace(str,retxt,replacetxt)
	Dim Re
	retxt = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(retxt, "[", "\["), "]", "\]"), "(", "\("), ")", "\)"), "$", "\$"), "^", "\^"), "{", "\{"), "}", "\}"), "+", "\+"), ".", "\.")
	'replacetxt = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(replacetxt, "[", "\["), "]", "\]"), "(", "\("), ")", "\)"), "$", "\$"), "^", "\^"), "{", "\{"), "}", "\}"), "+", "\+"), ".", "\.")
	Set Re = New RegExp
	Re.IgnoreCase = True
	Re.Global = True
	Re.Pattern = retxt
	Re_Replace = Re.Replace(str,replacetxt)
	Set Re = Nothing
End Function
%>