<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <% Response.Buffer = True Response.ExpiresAbsolute = Now() - 1 Response.Expires = 0 Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "No-Cache" Server.ScriptTimeOut = 1800 %> <% '版本号 Const sysVersion = "2.9.3" '页面标题 Const systemPageTitle = "isP-CMS中央管理平台" '打开关闭系统验证码 Const useSiteManageCode = false '系统验证码 Const SiteManageCode = "ssss" '打开关闭随机验证码 Const useCheckCode = false '系统开始日期，关系到日志查询的开始日期 Const startdate = "2010-10-22" '页面刷新频率，单位ms Const refreshRate = 10000 '打开关闭 菜单管理 和 设备管理 Const showAdmin = false '打开关闭 用户管理 Const showUserAdmin = false '打开关闭用户日志,开启此项须确保数据库中有t_user_log表存在 Const useUserLog = false '日志报表选项============================================= '是否允许多项选择 Const multiple = false '允许多项选择时限制同时选择数量 Const reportNum = 3 '选择日期限制 Const dateLimit = 5 '默认是否开启报警音 Const openSound = true '是否开启短信查询 Const allowSmsSearch = true '是否开启电话查询 Const allowTelSearch = true '是否开启Email查询 Const allowEmailSearch = false '是否打开历史记录查询 Const allowHistoryDataSearch = false Dim Action, ComeUrl Dim FoundErr, ErrMsg Dim strFiles, tUsed dim strInstallDir Dim regEx, Match, Match2, Matches, Matches2 Set regEx = New RegExp regEx.IgnoreCase = True regEx.Global = True regEx.MultiLine = True ComeUrl = FilterJs(Trim(Request("ComeUrl"))) If ComeUrl = "" Then ComeUrl = FilterJs(Trim(Request.ServerVariables("HTTP_REFERER"))) End If Action = ReplaceBadChar(Trim(Request("Action"))) Dim DatePart_D, DatePart_Y, DatePart_M, DatePart_W, DatePart_H, DatePart_Now DatePart_D = "'d'" DatePart_Y = "'yyyy'" DatePart_M = "'m'" DatePart_W = "'ww'" DatePart_H = "'h'" DatePart_Now = "Now()" Dim FileName, strFileName, MaxPerPage, CurrentPage, totalPut Dim SearchType, strField, Keyword If Request("page") <> "" Then CurrentPage = oCLng(Request("page")) Else CurrentPage = 1 End If If request("MaxPerPage")<>"" and IsNumeric(request("MaxPerPage")) then MaxPerPage = Fix(CDbl(request("MaxPerPage"))) else MaxPerPage = 20 end if Call OpenConn Dim UserTrueIP UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR") UserTrueIP = ReplaceBadChar(UserTrueIP) Function GetRndPassword(PasswordLen) Dim Ran, i, strPassword strPassword = "" For i = 1 To PasswordLen Randomize Ran = CInt(Rnd * 2) Randomize If Ran = 0 Then Ran = CInt(Rnd * 25) + 97 strPassword = strPassword & UCase(Chr(Ran)) ElseIf Ran = 1 Then Ran = CInt(Rnd * 9) strPassword = strPassword & Ran ElseIf Ran = 2 Then Ran = CInt(Rnd * 25) + 97 strPassword = strPassword & Chr(Ran) End If Next GetRndPassword = strPassword End Function Function CheckBadChar(strChar) Dim strBadChar, arrBadChar, i strBadChar = "@@,+,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & ",--" arrBadChar = Split(strBadChar, ",") If strChar = "" Then CheckBadChar = False Else For i = 0 To UBound(arrBadChar) If InStr(strChar, arrBadChar(i)) > 0 Then CheckBadChar = False Exit Function End If Next End If CheckBadChar = True End Function Function ReplaceBadChar(strChar) If strChar = "" Or IsNull(strChar) Then ReplaceBadChar = "" Exit Function End If Dim strBadChar, arrBadChar, tempChar, i strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ",--" arrBadChar = Split(strBadChar, ",") tempChar = strChar For i = 0 To UBound(arrBadChar) tempChar = Replace(tempChar, arrBadChar(i), "") Next tempChar = Replace(tempChar, "@@", "@") ReplaceBadChar = tempChar End Function Dim ScriptName ScriptName = Trim(Request.ServerVariables("SCRIPT_NAME")) UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR") UserTrueIP = ReplaceBadChar(UserTrueIP) Function GetScriptName() Dim ScriptName ScriptName = Trim(Request.ServerVariables("SCRIPT_NAME")) If InStr(ScriptName, "?") > 0 Then ScriptName = Left(ScriptName, InStr(ScriptName, "?")) End If GetScriptName = ScriptName End Function Function GetPostString() Dim PostString, PostItem PostString = "" If Request.Form <> "" Then PostString = PostString & "Request.Form" For Each PostItem In Request.Form PostString = PostString & PostItem & "=" & Request.Form(PostItem) & "&" Next If Right(PostString, 1) = "&" Then PostString = Left(PostString, Len(PostString) - 1) End If If Request.QueryString <> "" Then If PostString <> "" Then PostString = PostString & vbCrLf PostString = PostString & "Request.QueryString" For Each PostItem In Request.QueryString PostString = PostString & PostItem & "=" & Request.QueryString(PostItem) & "&" Next If Right(PostString, 1) = "&" Then PostString = Left(PostString, Len(PostString) - 1) End If GetPostString = PostString End Function Function oCLng(ByVal str1) If IsNumeric(str1) Then oCLng = Fix(CDbl(str1)) Else oCLng = 0 End If End Function Public Sub ShowJS_Main(ItemName) Response.Write "" & vbCrLf End Sub Function oHTMLEncode(ByVal fString) If IsNull(fString) Or Trim(fString) = "" Then oHTMLEncode = "" Exit Function End If fString = Replace(fString, ">", ">") fString = Replace(fString, "<", "<") fString = Replace(fString, Chr(32), " ") fString = Replace(fString, Chr(9), " ") fString = Replace(fString, Chr(34), """) fString = Replace(fString, Chr(39), "'") fString = Replace(fString, Chr(13), "") fString = Replace(fString, Chr(10) & Chr(10), "

") fString = Replace(fString, Chr(10), "
") oHTMLEncode = fString End Function Function ShowPage(sfilename, totalnumber, MaxPerPage, CurrentPage, ShowTotal, ShowAllPages, strUnit, ShowMaxPerPage) Dim TotalPage, strTemp, strUrl, i If totalnumber = 0 Or MaxPerPage = 0 Or IsNull(MaxPerPage) Then ShowPage = "" Exit Function End If If totalnumber Mod MaxPerPage = 0 Then TotalPage = totalnumber \ MaxPerPage Else TotalPage = totalnumber \ MaxPerPage + 1 End If If CurrentPage > TotalPage Then CurrentPage = TotalPage strTemp = "" If ShowTotal = True Then strTemp = strTemp & "共 " & totalnumber & " " & strUnit & "   " End If If ShowMaxPerPage = True Then strUrl = JoinChar(sfilename) & "MaxPerPage=" & MaxPerPage & "&" Else strUrl = JoinChar(sfilename) End If If CurrentPage = 1 Then strTemp = strTemp & "首页 | 上一页 |" Else strTemp = strTemp & "首页 |" strTemp = strTemp & " 上一页 | " End If strTemp = strTemp & " " If ShowAllPages = True Then Dim Jmaxpages If (CurrentPage - 4) <= 0 Or TotalPage < 10 Then Jmaxpages = 1 Do While (Jmaxpages < 10) If Jmaxpages = CurrentPage Then strTemp = strTemp & "" & Jmaxpages & " " Else If strUrl <> "" Then strTemp = strTemp & "" & Jmaxpages & " " End If End If If Jmaxpages = TotalPage Then Exit Do Jmaxpages = Jmaxpages + 1 Loop ElseIf (CurrentPage + 4) >= TotalPage Then Jmaxpages = TotalPage - 8 Do While (Jmaxpages <= TotalPage) If Jmaxpages = CurrentPage Then strTemp = strTemp & "" & Jmaxpages & " " Else If strUrl <> "" Then strTemp = strTemp & "" & Jmaxpages & " " End If End If Jmaxpages = Jmaxpages + 1 Loop Else Jmaxpages = CurrentPage - 4 Do While (Jmaxpages < CurrentPage + 5) If Jmaxpages = CurrentPage Then strTemp = strTemp & "" & Jmaxpages & " " Else If strUrl <> "" Then strTemp = strTemp & "" & Jmaxpages & " " End If End If Jmaxpages = Jmaxpages + 1 Loop End If End If If CurrentPage >= TotalPage Then strTemp = strTemp & "| 下一页 | 尾页" Else strTemp = strTemp & " | 下一页 |" strTemp = strTemp & " 尾页" End If If ShowMaxPerPage = True Then strTemp = strTemp & "   " & strUnit & "/页" Else strTemp = strTemp & " " & MaxPerPage & "" & strUnit & "/页" End If If ShowAllPages = True Then strTemp = strTemp & "  转到第页" End If ShowPage = strTemp End Function Function JoinChar(ByVal strUrl) If strUrl = "" Then JoinChar = "" Exit Function End If If InStr(strUrl, "?") < Len(strUrl) Then If InStr(strUrl, "?") > 1 Then If InStr(strUrl, "&") < Len(strUrl) Then JoinChar = strUrl & "&" Else JoinChar = strUrl End If Else JoinChar = strUrl & "?" End If Else JoinChar = strUrl End If End Function Sub WriteSuccessMsg(sSuccessMsg, sComeUrl) Response.Write "成功信息" & vbCrLf Response.Write "

" & vbCrLf Response.Write "" & vbCrLf Response.Write " " & vbCrLf Response.Write " " & vbCrLf Response.Write " " & vbCrLf Response.Write "
恭喜你！

" & sSuccessMsg & "
" If sComeUrl <> "" Then Response.Write "<< 返回上一页" Else Response.Write "【关闭】" End If Response.Write "
" & vbCrLf Response.Write "" & vbCrLf End Sub Sub WriteErrMsg(sErrMsg, sComeUrl) Response.Write "错误信息" & vbCrLf Response.Write "

" & vbCrLf Response.Write "" & vbCrLf Response.Write " " & vbCrLf Response.Write " " & vbCrLf Response.Write " " & vbCrLf Response.Write "
错误信息
产生错误的可能原因：" & sErrMsg & "
" If sComeUrl <> "" Then Response.Write "<< 返回上一页" Else Response.Write "【关闭】" End If Response.Write "
" & vbCrLf Response.Write "" & vbCrLf End Sub Function IsValidID(Check_ID) Dim FixID, i If IsNull(Check_ID) Or Check_ID = "" Then IsValidID = False Exit Function End If FixID = Replace(Check_ID, "|", "") FixID = Replace(FixID, ",", "") FixID = Replace(FixID, "-", "") FixID = Trim(Replace(FixID, " ", "")) If FixID = "" Or IsNull(FixID) Then IsValidID = False Else For i = 1 To Len(FixID) Step 100 If Not IsNumeric(Mid(FixID, i, 100)) Then IsValidID = False Exit Function End If Next IsValidID = True End If End Function Function FilterJS(ByVal strInput) If IsNull(strInput) Or Trim(strInput) = "" Then FilterJS = "" Exit Function End If Dim reContent ' 替换掉HTML字符实体(Character Entities)名字和分号之间的空白字符，比如：ä ;替换成ä regEx.Pattern = "(&#*\w+)[\x00-\x20]+;" strInput = regEx.Replace(strInput, "$1;") ' 将无分号结束符的数字编码实体规范成带分号的标准形式 regEx.Pattern = "(&#x*[0-9A-F]+);*" strInput = regEx.Replace(strInput, "$1;") ' 将  < > & "字符实体中的 & 替换成 & 以便在进行HtmlDecode时保留这些字符实体 'RegEx.Pattern = "&(amp|lt|gt|nbsp|quot);" 'strInput = RegEx.Replace(strInput, "&$1;") ' 将HTML字符实体进行解码，以消除编码字符对后续过滤的影响 'strInput = HtmlDecode(strInput); ' 将ASCII码表中前32个字符中的非打印字符替换成空字符串，保留 9、10、13、32，它们分别代表 制表符、换行符、回车符和空格。 regEx.Pattern = "[\x00-\x08\x0b-\x0c\x0e-\x19]" strInput = regEx.Replace(strInput, "") oldhtmlString = "" Do While oldhtmlString <> strInput oldhtmlString = strInput regEx.Pattern = "(<[^>]+src[\x00-\x20]*=[\x00-\x20]*[^>]*?)&#([^>]*>)" '过虑掉 src 里的 &# strInput = regEx.Replace(strInput, "$1&#$2") regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)&#([^>]*>)" '过虑掉style 里的 &# strInput = regEx.Replace(strInput, "$1&#$2") regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)\\([^>]*>)" '替换掉style中的 "\" strInput = regEx.Replace(strInput, "$1/$2") Loop ' 替换以on和xmlns开头的属性，动易系统的几个JS需要保留 regEx.Pattern = "on(load\s*=\s*""*'*resizepic\(this\)'*""*)" strInput = regEx.Replace(strInput, "off$1") regEx.Pattern = "on(mousewheel\s*=\s*""*'*return\s*bbimg\(this\)'*""*)" strInput = regEx.Replace(strInput, "off$1") regEx.Pattern = "(<[^>]+[\x00-\x20""'/])(on|xmlns)([^>]*)>" strInput = regEx.Replace(strInput, "$1pe$3>") regEx.Pattern = "off(load\s*=\s*""*'*resizepic\(this\)'*""*)" strInput = regEx.Replace(strInput, "on$1") regEx.Pattern = "off(mousewheel\s*=\s*""*'*return\s*bbimg\(this\)'*""*)" strInput = regEx.Replace(strInput, "on$1") ' 替换javascript regEx.Pattern = "([a-z]*)[\x00-\x20]*=[\x00-\x20]*([`'""]*)[\x00-\x20]*j[\x00-\x20]*a[\x00-\x20]*v[\x00-\x20]*a[\x00-\x20]*s[\x00-\x20]*c[\x00-\x20]*r[\x00-\x20]*i[\x00-\x20]*p[\x00-\x20]*t[\x00-\x20]*:" strInput = regEx.Replace(strInput, "$1=$2nojavascript...") ' 替换vbscript regEx.Pattern = "([a-z]*)[\x00-\x20]*=[\x00-\x20]*([`'""]*)[\x00-\x20]*v[\x00-\x20]*b[\x00-\x20]*s[\x00-\x20]*c[\x00-\x20]*r[\x00-\x20]*i[\x00-\x20]*p[\x00-\x20]*t[\x00-\x20]*:" strInput = regEx.Replace(strInput, "$1=$2novbscript...") '替换style中的注释部分，比如：

regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)/\*[^>]*\*/([^>]*>)" strInput = regEx.Replace(strInput, "$1$2") ' 替换expression regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*[eｅＥ][xｘＸ][pｐＰ][rｒＲ][eｅＥ][sｓＳ][sｓＳ][iｉＩ][oｏＯ][nｎＮ][\x00-\x20]*[\(\（][^>]*>" strInput = regEx.Replace(strInput, "$1>") ' 替换behaviour regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*behaviour[^>]*>>" strInput = regEx.Replace(strInput, "$1>") ' 替换behavior regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*behavior[^>]*>>" strInput = regEx.Replace(strInput, "$1>") ' 替换script regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*s[\x00-\x20]*c[\x00-\x20]*r[\x00-\x20]*i[\x00-\x20]*p[\x00-\x20]*t[\x00-\x20]*:*[^>]*>" strInput = regEx.Replace(strInput, "$1>") ' 替换namespaced elements 不需要 regEx.Pattern = "]*>" strInput = regEx.Replace(strInput, "　") Dim oldhtmlString oldhtmlString = "" Do While oldhtmlString <> strInput oldhtmlString = strInput '实行严格过滤 regEx.Pattern = "]*>?" strInput = regEx.Replace(strInput, "　") '过滤掉SHTML的Include包含文件漏洞 regEx.Pattern = "