123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485 |
- <!--#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 = "| "
- 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 & " <a href='" & FileName & "&ClassID=" & rsChild(0) & "'><font color='red'>" & rsChild(1) & "</font></a>"
- Else
- strChild = strChild & " <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 & " "
- 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 & " "
- If i = tmpDepth Then
- If rsClass("NextID") > 0 Then
- strClass_Option = strClass_Option & "├ "
- Else
- strClass_Option = strClass_Option & "└ "
- End If
- Else
- If arrShowLine(i) = True Then
- strClass_Option = strClass_Option & "|"
- Else
- strClass_Option = strClass_Option & " "
- 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' >移动到>></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';""> "
- 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 & " "
- If i = tmpDepth Then
- If rsClass("NextID") > 0 Then
- strClass_Option = strClass_Option & "├ "
- Else
- strClass_Option = strClass_Option & "└ "
- End If
- Else
- If arrShowLine(i) = True Then
- strClass_Option = strClass_Option & "│"
- Else
- strClass_Option = strClass_Option & " "
- 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
- %>
|