repos_ecs/源数据/PC环境监控/3.0.3.2/BS/common.asp

<!--#include file="inc/common.asp"-->
<%
Server.ScriptTimeOut = 9999999

Dim NeedCheckComeUrl

If NeedCheckComeUrl = True Then
    Call CheckComeUrl
End If

Dim ObjInstalled_FSO, fso

ObjInstalled_FSO = IsObjInstalled("Scripting.FileSystemObject")
If ObjInstalled_FSO = True Then
   Set fso = Server.CreateObject("Scripting.FileSystemObject")
Else
   Response.Write "<li>FSO组件不可用，各种与FSO相关的功能都将出错！请运行Install.asp或者到后台网站配置处设置好FSO组件名称。</li>"
End If

Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    Set xTestObj = CreateObject(strClassString)
    If Err.Number = 0 Then IsObjInstalled = True
    Set xTestObj = Nothing
    Err = 0
End Function

Sub CheckComeUrl()
    Dim ComeUrl, TrueSiteUrl, cUrl
    ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER"))
    TrueSiteUrl = Trim(Request.ServerVariables("HTTP_HOST"))
    If ComeUrl = "" Then
        Response.Write "<br><p align=center><font color='red'>不允许直接输入地址访问此页面</font></p>"
        Response.End
    Else
        cUrl = Trim("http://" & TrueSiteUrl) & ScriptName
        If LCase(Left(ComeUrl, InStrRev(ComeUrl, "/"))) <> LCase(Left(cUrl, InStrRev(cUrl, "/"))) Then
            Response.Write "<br><p align=center><font color='red'>不允许从外部链接访问此页面</font></p>"
            Response.End
        End If
    End If
End Sub

'检查登录
Dim AdminID, AdminName, AdminPassword, RndPassword, AdminLoginCode
Dim rsGetAdmin, sqlGetAdmin
AdminName = ReplaceBadChar(Trim(Request.Cookies("AdminName")))
AdminPassword = ReplaceBadChar(Trim(Request.Cookies("AdminPassword")))
'RndPassword = ReplaceBadChar(Trim(Request.Cookies("RndPassword")))
'AdminLoginCode = ReplaceBadChar(Trim(Request.Cookies("AdminLoginCode")))
If AdminName = "" Or AdminPassword = "" Then 'Or RndPassword = "" Or (AdminLoginCode <> SiteManageCode)
    Call CloseConn
    Response.redirect "login.asp"
End If
sqlGetAdmin = "select * from t_user_info where uid='" & AdminName & "' and pwd='" & AdminPassword & "'"
Set rsGetAdmin = Server.CreateObject("adodb.recordset")
rsGetAdmin.Open sqlGetAdmin, Conn, 1, 1
If rsGetAdmin.BOF And rsGetAdmin.EOF Then
    rsGetAdmin.Close
    Set rsGetAdmin = Nothing
    Call CloseConn
    Response.redirect "login.asp"
End If
If rsGetAdmin("status") = False Then
	response.write "<font color=red>用户已锁定！</font>"
	response.End
	Call CloseConn
End If

Public Sub ShowJS_Manage(ItemName)
    Dim strJS
    Response.Write "<SCRIPT language=javascript>" & vbCrLf
    Response.Write "function CheckItem(CB){" & vbCrLf
    Response.Write "  var tagname=(arguments.length>1)?arguments[1]:'TR';" & vbCrLf
    Response.Write "  if(document.myform.chkAll.checked){" & vbCrLf
    Response.Write "    document.myform.chkAll.checked = document.myform.chkAll.checked&0;" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "  if (CB.checked){hL(CB,tagname)};else{dL(CB,tagname)};" & vbCrLf
    Response.Write "  var TB=TO=0;" & vbCrLf
    Response.Write "  for (var i=0;i<myform.elements.length;i++) {" & vbCrLf
    Response.Write "    var e=myform.elements[i];" & vbCrLf
    Response.Write "    if ((e.name != 'chkAll') && (e.type=='checkbox')) {" & vbCrLf
    Response.Write "      TB++;" & vbCrLf
    Response.Write "      if (e.checked) TO++;" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "  myform.chkAll.checked=(TO==TB)?true:false;" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function CheckAll(form){" & vbCrLf
    Response.Write "  var tagname=(arguments.length>1)?arguments[1]:'TR';" & vbCrLf
    Response.Write "  for (var i=0;i<form.elements.length;i++){" & vbCrLf
    Response.Write "    var e = form.elements[i];" & vbCrLf
    Response.Write "    if (e.name != 'chkAll' && e.disabled == false && e.type == 'checkbox') {" & vbCrLf
    Response.Write "      e.checked = form.chkAll.checked;" & vbCrLf
    Response.Write "      if (e.checked){hL(e,tagname)};else{dL(e,tagname)};" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function hL(E,tagname){" & vbCrLf
    Response.Write "  while (E.tagName!=tagname) {E=E.parentElement;}" & vbCrLf
    Response.Write "  E.className='tdbg2';" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function dL(E,tagname){" & vbCrLf
    Response.Write "  while (E.tagName!=tagname) {E=E.parentElement;}" & vbCrLf
    Response.Write "  E.className='tdbg';" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function ConfirmDel(){" & vbCrLf
    Response.Write " if(document.myform.Action.value=='Del'){" & vbCrLf
    Response.Write "     if(confirm('确定要删除选中的" & ItemName & "吗？本操作将把选中的" & ItemName & "移到回收站中。必要时您可从回收站中恢复！'))" & vbCrLf
    Response.Write "         return true;" & vbCrLf
    Response.Write "     else" & vbCrLf
    Response.Write "         return false;" & vbCrLf
    Response.Write " }" & vbCrLf
    Response.Write " else if(document.myform.Action.value=='ConfirmDel'){" & vbCrLf
    Response.Write "     if(confirm('确定要彻底删除选中的" & ItemName & "吗？彻底删除后将不能恢复！'))" & vbCrLf
    Response.Write "         return true;" & vbCrLf
    Response.Write "     else" & vbCrLf
    Response.Write "         return false;" & vbCrLf
    Response.Write " }" & vbCrLf
    Response.Write " else if(document.myform.Action.value=='ClearRecyclebin'){" & vbCrLf
    Response.Write "     if(confirm('确定要清空回收站？一旦清空将不能恢复！'))" & vbCrLf
    Response.Write "         return true;" & vbCrLf
    Response.Write "     else" & vbCrLf
    Response.Write "         return false;" & vbCrLf
    Response.Write " }" & vbCrLf
    Response.Write " else if(document.myform.Action.value=='DelFromSpecial'){" & vbCrLf
    Response.Write "     if(confirm('确定要将选中的" & ItemName & "从其所属专题中删除吗？操作成功后" & ItemName & "将不属于任何专题。'))" & vbCrLf
    Response.Write "         return true;" & vbCrLf
    Response.Write "     else" & vbCrLf
    Response.Write "         return false;" & vbCrLf
    Response.Write " }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "</SCRIPT>" & vbCrLf
End Sub

Public Function GetRootClass()
    Dim sqlRoot, rsRoot, strRoot
    sqlRoot = "select ClassID,ClassName,RootID,Child from class where ChannelID=" & ChannelID & " and ParentID=0 and ClassType=1 order by RootID"
    Set rsRoot = Conn.Execute(sqlRoot)
    If rsRoot.BOF And rsRoot.EOF Then
        strRoot = "沒有分類"
    Else
        strRoot = "|&nbsp;"
        Do While Not rsRoot.EOF
            If rsRoot(2) = RootID Then
                strRoot = strRoot & "<a href='" & FileName & "&ClassID=" & rsRoot(0) & "'><font color=red>" & rsRoot(1) & "</font></a> | "
            Else
                strRoot = strRoot & "<a href='" & FileName & "&ClassID=" & rsRoot(0) & "'>" & rsRoot(1) & "</a> | "
            End If
            rsRoot.MoveNext
        Loop
    End If
    rsRoot.Close
    Set rsRoot = Nothing
    GetRootClass = strRoot
End Function

Public Function GetChild_Root()
    Dim sqlChild, rsChild, arrParentPath, isCurrent, strChild, i
    If RootID <= 0 Then
        GetChild_Root = ""
        Exit Function
    End If
    sqlChild = "select ClassID,ClassName,Child from class where ChannelID=" & ChannelID & " and Depth=1 and RootID=" & RootID & " order by OrderID"
    Set rsChild = Conn.Execute(sqlChild)
    If Not (rsChild.BOF And rsChild.EOF) Then
        i = 1
        arrParentPath = Split(ParentPath, ",")
        strChild = "<tr  style='background:#f2f4f6;border-top:#FFF solid 1px;border-bottom:#c1c8d2 solid 1px;padding:0 20px'><td>"
        Do While Not rsChild.EOF
            If Depth <= 1 Then
                If rsChild(0) = ClassID Then
                    isCurrent = True
                Else
                    isCurrent = False
                End If
            Else
                If PE_CLng(arrParentPath(2)) = rsChild(0) Then
                    isCurrent = True
                Else
                    isCurrent = False
                End If
            End If
            If isCurrent = True Then
                strChild = strChild & "&nbsp;&nbsp;<a href='" & FileName & "&ClassID=" & rsChild(0) & "'><font color='red'>" & rsChild(1) & "</font></a>"
            Else
                strChild = strChild & "&nbsp;&nbsp;<a href='" & FileName & "&ClassID=" & rsChild(0) & "'>" & rsChild(1) & "</a>"
            End If
            If rsChild(2) > 0 Then
                strChild = strChild & "(" & rsChild(2) & ")"
            End If
            If i Mod 8 = 0 Then
                strChild = strChild & "<br>"
            Else
                strChild = strChild & "&nbsp;&nbsp;"
            End If
            rsChild.MoveNext
            i = i + 1
        Loop
        strChild = strChild & "</td></tr>"
    End If
    rsChild.Close
    Set rsChild = Nothing
    GetChild_Root = strChild
End Function

Function GetNewID(SheetName, FieldName)
    Dim mrs
    Set mrs = Conn.Execute("select max(" & FieldName & ") from " & SheetName & "")
    If IsNull(mrs(0)) Then
        GetNewID = 1
    Else
        GetNewID = mrs(0) + 1
    End If
    Set mrs = Nothing
End Function

Public Function ShowClassPath()
    If ParentPath = "" Or IsNull(ParentPath) Then
        ShowClassPath = "不属于任何区域"
        Exit Function
    End If
    Dim strPath
    If Depth > 0 Then
        Dim rsPath
        Set rsPath = Conn.Execute("select * from class where ClassID in (" & ParentPath & ") order by Depth")
        Do While Not rsPath.EOF
            strPath = strPath & rsPath("ClassName") & " >> "
            rsPath.MoveNext
        Loop
        rsPath.Close
        Set rsPath = Nothing
    End If
    strPath = strPath & ClassName
    ShowClassPath = strPath
End Function

Function GetClass_Option(ShowType, CurrentID)
    Dim rsClass, sqlClass, strClass_Option, tmpDepth, i, ClassNum
    Dim arrShowLine(20)
    ClassNum = 1
    'CurrentID = PE_CLng(CurrentID)
    
    For i = 0 To UBound(arrShowLine)
        arrShowLine(i) = False
    Next
    sqlClass = "Select * from class where ChannelID=" & ChannelID & " order by RootID,OrderID"
    Set rsClass = Conn.Execute(sqlClass)
    If rsClass.BOF And rsClass.EOF Then
        strClass_Option = strClass_Option & "<option value=''>请先添加区域</option>"
    Else
        Do While Not rsClass.EOF
            ClassNum = ClassNum + 1
            tmpDepth = rsClass("Depth")
            If rsClass("NextID") > 0 Then
                arrShowLine(tmpDepth) = True
            Else
                arrShowLine(tmpDepth) = False
            End If
            If ShowType = 1 Then
                If rsClass("ClassType") = 2 Then
                    strClass_Option = strClass_Option & "<option value=''"
                Else
                    strClass_Option = strClass_Option & "<option value='" & rsClass("ClassID") & "'"
                End If
                If AdminPurview = 2 Then
                    If CheckPurview_Class(arrClass_Check, rsClass("ClassID")) = True Then
                        strClass_Option = strClass_Option & "style='background-color:#ff0000'"
                    End If
                End If
            ElseIf ShowType = 2 Then
                If rsClass("ClassType") = 2 Then
                    strClass_Option = strClass_Option & "<option value=''"
                Else
                    strClass_Option = strClass_Option & "<option value='" & rsClass("ClassID") & "'"
                End If
                If AdminPurview = 2 Then
                    If CheckPurview_Class(arrClass_Manage, rsClass("ClassID")) = True Then
                        strClass_Option = strClass_Option & "style='background-color:#ff0000'"
                    End If
                End If
            ElseIf ShowType = 3 Then
                If rsClass("ClassType") = 2 Then
                    strClass_Option = strClass_Option & "<option value=''"
                Else
                    If rsClass("Child") > 0 Then
                        strClass_Option = strClass_Option & "<option value='0'"
                    Else
                        strClass_Option = strClass_Option & "<option value='" & rsClass("ClassID") & "'"
                    End If
                End If
            Else
                If rsClass("ClassType") = 2 Then
                    strClass_Option = strClass_Option & "<option value=''"
                Else
                    strClass_Option = strClass_Option & "<option value='" & rsClass("ClassID") & "'"
                End If
            End If
            If FoundInArr(CurrentID, rsClass("ClassID"), ",") Then
                strClass_Option = strClass_Option & " selected"
            End If
            strClass_Option = strClass_Option & ">"
            
            If tmpDepth > 0 Then
                For i = 1 To tmpDepth
                    strClass_Option = strClass_Option & "&nbsp;&nbsp;"
                    If i = tmpDepth Then
                        If rsClass("NextID") > 0 Then
                            strClass_Option = strClass_Option & "├&nbsp;"
                        Else
                            strClass_Option = strClass_Option & "└&nbsp;"
                        End If
                    Else
                        If arrShowLine(i) = True Then
                            strClass_Option = strClass_Option & "|"
                        Else
                            strClass_Option = strClass_Option & "&nbsp;"
                        End If
                    End If
                Next
            End If
            strClass_Option = strClass_Option & rsClass("ClassName")
            If rsClass("ClassType") = 2 Then
                strClass_Option = strClass_Option & "(外)"
            End If
            strClass_Option = strClass_Option & "</option>"
            ClassNum = ClassNum + 1
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing
    If ShowType = 3 And AdminPurview = 1 Then
        strClass_Option = strClass_Option & "<option value='-1'"
        If oCLng(CurrentID) = -1 Then strClass_Option = strClass_Option & " selected"
        strClass_Option = strClass_Option & ">不指定任何区域</option>"
    End If
    If ShowType = 0 And AdminPurview = 1 Then
        strClass_Option = strClass_Option & "<option value='-1'"
        If oCLng(CurrentID) = -1 Then strClass_Option = strClass_Option & " selected"
        strClass_Option = strClass_Option & ">不指定任何区域</option>"
    End If
    GetClass_Option = strClass_Option
End Function

Sub ShowForm_MoveToClass()
    
    Dim tChannelID, BatchInfoID
    tChannelID = Trim(Request("tChannelID"))
    If tChannelID = "" Then
        tChannelID = ChannelID
    Else
        tChannelID = CLng(tChannelID)
    End If
    BatchInfoID = ReplaceBadChar(Request("Batch" & ModuleName & "ID"))
    If BatchInfoID = "" Then
        BatchInfoID = ReplaceBadChar(Request(ModuleName & "ID"))
    End If
        
    Response.Write "<form method='POST' name='myform' action='" & ModuleName & ".asp' target='_self'>"
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='4' align='center'><b>批量移动" & ChannelShortName & "</td>"
    Response.Write "    </tr>"
    Response.Write "    <tr align='left' class='tdbg'>"
    Response.Write "      <td valign='top' width='300'>"
    Response.Write "        <input type='radio' name='" & ModuleName & "Type' value='1' checked>指定" & ChannelShortName & "ID：<input type='text' name='Batch" & ModuleName & "ID' value='" & BatchInfoID & "' size='30'><br>"
    Response.Write "        <input type='radio' name='" & ModuleName & "Type' value='2'>指定区域的" & ChannelShortName & "：<br><select name='BatchClassID' size='2' multiple style='height:240px;width:300px;'>" & GetClass_Option(channelid, 0) & "</select><br>"
    Response.Write "        <input type='button' name='Submit' value='  选定所有区域  ' onclick='SelectAll()'>"
    Response.Write "        <input type='button' name='Submit' value='取消选定所有区域' onclick='UnSelectAll()'>"
    Response.Write "      </td>"
    Response.Write "      <td align='center' >移动到&gt;&gt;</td>"
    Response.Write "      <td valign='top'>"
    Response.Write "        目标区域：<font color=red>（不能指定为外部区域）</font><br><select name='tClassID' size='2' style='height:290px;width:300px;'>" & GetClass_Channel(tChannelID) & "</select>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "  <p align='center'>"
    Response.Write "    <input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
    Response.Write "    <input name='Action' type='hidden' id='Action' value='MoveToClass'>"
    Response.Write "    <input name='add' type='submit'  id='Add' value=' 执行批处理 ' style='cursor:hand;' onClick=""document.myform.Action.value='DoMoveToClass';"">&nbsp; "
    Response.Write "    <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='" & ModuleName & ".asp?ChannelID=" & ChannelID & "&Action=Manage';"" style='cursor:hand;'>"
    Response.Write "  </p>"
    Response.Write "</form>"
    Response.Write "<script language='javascript'>" & vbCrLf
    Response.Write "function SelectAll(){" & vbCrLf
    Response.Write "  for(var i=0;i<document.myform.BatchClassID.length;i++){" & vbCrLf
    Response.Write "    document.myform.BatchClassID.options[i].selected=true;}" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function UnSelectAll(){" & vbCrLf
    Response.Write "  for(var i=0;i<document.myform.BatchClassID.length;i++){" & vbCrLf
    Response.Write "    document.myform.BatchClassID.options[i].selected=false;}" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "</script>" & vbCrLf
End Sub

Function GetClass_Channel(iChannelID)
    Dim rsClass, sqlClass, strClass_Option, tmpDepth, i
    Dim arrShowLine(20)
    For i = 0 To UBound(arrShowLine)
        arrShowLine(i) = False
    Next
    sqlClass = "Select * from Class where ChannelID=" & iChannelID & " order by RootID,OrderID"
    Set rsClass = Conn.Execute(sqlClass)
    If rsClass.BOF And rsClass.EOF Then
        strClass_Option = strClass_Option & "<option value=''>请先添加区域</option>"
    Else
        Do While Not rsClass.EOF
            tmpDepth = rsClass("Depth")
            If rsClass("NextID") > 0 Then
                arrShowLine(tmpDepth) = True
            Else
                arrShowLine(tmpDepth) = False
            End If
            If rsClass("ClassType") = 2 Then
                strClass_Option = strClass_Option & "<option value=''"
            Else
                If rsClass("Child") > 0 And rsClass("EnableAdd") = False Then
                    strClass_Option = strClass_Option & "<option value='0'"
                Else
                    strClass_Option = strClass_Option & "<option value='" & rsClass("ClassID") & "'"
                End If
            End If
            strClass_Option = strClass_Option & ">"
            
            If tmpDepth > 0 Then
                For i = 1 To tmpDepth
                    strClass_Option = strClass_Option & "&nbsp;&nbsp;"
                    If i = tmpDepth Then
                        If rsClass("NextID") > 0 Then
                            strClass_Option = strClass_Option & "├&nbsp;"
                        Else
                            strClass_Option = strClass_Option & "└&nbsp;"
                        End If
                    Else
                        If arrShowLine(i) = True Then
                            strClass_Option = strClass_Option & "│"
                        Else
                            strClass_Option = strClass_Option & "&nbsp;"
                        End If
                    End If
                Next
            End If
            strClass_Option = strClass_Option & rsClass("ClassName")
            If rsClass("ClassType") = 2 Then
                strClass_Option = strClass_Option & "(外)"
            End If
            strClass_Option = strClass_Option & "</option>"
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing
    strClass_Option = strClass_Option & "<option value='-1'>未指定任何区域</option>"
    GetClass_Channel = strClass_Option
End Function

Function FilterArrNull(ByVal ArrString, ByVal CompartString)
    Dim arrContent, arrTemp, i

    If CompartString = "" Or ArrString = "" Then
        FilterArrNull = ArrString
        Exit Function
    End If
    If InStr(ArrString, CompartString) = 0 Then
        FilterArrNull = ArrString
        Exit Function
    Else
        arrContent = Split(ArrString, CompartString)
        For i = 0 To UBound(arrContent)
            If Trim(arrContent(i)) <> "" Then
                If arrTemp = "" Then
                    arrTemp = Trim(arrContent(i))
                Else
                    arrTemp = arrTemp & CompartString & Trim(arrContent(i))
                End If
            End If
        Next
    End If
    FilterArrNull = arrTemp
End Function
%>