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,"'", "'") 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>页 " & 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> </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> </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> </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> </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 %>