admin_sorting.asp
来自「多用户管理分权限发布、管理软件信息; 自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 1,046 行 · 第 1/3 页
ASP
1,046 行
NC_Admin.Error_Msg ("请不要和其他分类设置相同的序号")
End If
Set Rs = Newasp.Execute("select ID from NC_Template")
Do While Not Rs.EOF
Newasp.DelCahe ("SortingList" & Rs(0))
Newasp.DelCahe ("SortingMenu" & Rs(0))
Rs.movenext
Loop
Newasp.DelCahe "SortingJumpMenu"
Newasp.DelCahe "SortingJumpList"
Set Rs = Nothing
End Sub
Private Sub boardorders()
Dim trs
Dim uporders
Dim doorders
Response.Write " <table width=""96%"" border=""0"" cellspacing=""1"" cellpadding=""2"" class=""tableBorder"" align=center>"
Response.Write " <tr>"
Response.Write " <th colspan=2 class=""forumrow"">分类N级分类重新排序修改(请在相应软件分类的排序表单内输入相应的排列序号)"
Response.Write " </th>"
Response.Write " </tr>"
Set Rs = CreateObject("Adodb.recordset")
SQL = "select * from NC_SoftSort order by RootID,orders"
Rs.Open SQL, Conn, 1, 1
If Rs.bof And Rs.EOF Then
Response.Write "还没有相应的软件分类。"
Else
Do While Not Rs.EOF
Response.Write "<form action=admin_sorting.asp?action=updatboardorders method=post><tr><td width=""50%"" class=forumrow>"
If Rs("depth") = 1 Then Response.Write " <font color=""#666666"">├</font>"
If Rs("depth") > 1 Then
For i = 2 To Rs("depth")
Response.Write " <font color=""#666666"">│</font>"
Next
Response.Write " <font color=""#666666"">├</font> "
End If
If Rs("parentid") = 0 Then Response.Write ("<b>")
Response.Write Rs("sortname")
If Rs("child") > 0 Then Response.Write "(" & Rs("child") & ")"
Response.Write "</td><td width=""50%"" class=forumrow>"
If Rs("ParentID") > 0 Then
Set trs = Newasp.Execute("select count(*) from NC_SoftSort where ParentID=" & Rs("ParentID") & " and orders<" & Rs("orders") & "")
uporders = trs(0)
If IsNull(uporders) Then uporders = 0
Set trs = Newasp.Execute("select count(*) from NC_SoftSort where ParentID=" & Rs("ParentID") & " and orders>" & Rs("orders") & "")
doorders = trs(0)
If IsNull(doorders) Then doorders = 0
If uporders > 0 Then
Response.Write "<select name=uporders size=1><option value=0>↑</option>"
For i = 1 To uporders
Response.Write "<option value=" & i & ">↑" & i & "</option>"
Next
Response.Write "</select>"
End If
If doorders > 0 Then
If uporders > 0 Then Response.Write " "
Response.Write "<select name=doorders size=1><option value=0>↓</option>"
For i = 1 To doorders
Response.Write "<option value=" & i & ">↓" & i & "</option>"
Next
Response.Write "</select>"
End If
If doorders > 0 Or uporders > 0 Then
Response.Write "<input type=hidden name=""editID"" value=""" & Rs("sortid") & """> <input type=submit name=Submit class=button value='修 改'>"
End If
End If
Response.Write "</td></tr></form>"
uporders = 0
doorders = 0
Rs.movenext
Loop
End If
Rs.Close
Set Rs = Nothing
Response.Write "</table>"
End Sub
Private Sub updateboardorders()
Dim ParentID
Dim orders
Dim strParent
Dim Child
Dim uporders
Dim doorders
Dim oldorders
Dim trs
Dim ii
If Not IsNumeric(Request("editID")) Then
NC_Admin.Error_Msg ("非法的参数!")
Exit Sub
End If
If Request("uporders") <> "" And Not CInt(Request("uporders")) = 0 Then
If Not IsNumeric(Request("uporders")) Then
NC_Admin.Error_Msg ("非法的参数!")
Exit Sub
ElseIf CInt(Request("uporders")) = 0 Then
NC_Admin.Error_Msg ("请选择要提升的数字!")
Exit Sub
End If
Set Rs = Newasp.Execute("select ParentID,orders,strparent,child from NC_SoftSort where sortid=" & Request("editID"))
ParentID = Rs(0)
orders = Rs(1)
strParent = Rs(2) & "," & Request("editID")
Child = Rs(3)
i = 0
If Child > 0 Then
Set Rs = Newasp.Execute("select count(*) from NC_SoftSort where strparent like '%" & strParent & "%'")
oldorders = Rs(0)
Else
oldorders = 0
End If
Set Rs = Newasp.Execute("select sortid,orders,child,strparent from NC_SoftSort where ParentID=" & ParentID & " and orders<" & orders & " order by orders desc")
Do While Not Rs.EOF
i = i + 1
If CInt(Request("uporders")) >= i Then
If Rs(2) > 0 Then
ii = 0
Set trs = Newasp.Execute("select sortid,orders from NC_SoftSort where strparent like '%" & Rs(3) & "," & Rs(0) & "%' order by orders")
If Not (trs.EOF And trs.bof) Then
Do While Not trs.EOF
ii = ii + 1
Newasp.Execute ("update NC_SoftSort set orders=" & orders & "+" & oldorders & "+" & ii & " where sortid=" & trs(0))
trs.movenext
Loop
End If
End If
Newasp.Execute ("update NC_SoftSort set orders=" & orders & "+" & oldorders & " where sortid=" & Rs(0))
If CInt(Request("uporders")) = i Then uporders = Rs(1)
End If
orders = Rs(1)
Rs.movenext
Loop
Newasp.Execute ("update NC_SoftSort set orders=" & uporders & " where sortid=" & Request("editID"))
If Child > 0 Then
i = uporders
Set Rs = Newasp.Execute("select sortid from NC_SoftSort where strparent like '%" & strParent & "%' order by orders")
Do While Not Rs.EOF
i = i + 1
Newasp.Execute ("update NC_SoftSort set orders=" & i & " where sortid=" & Rs(0))
Rs.movenext
Loop
End If
Set Rs = Nothing
Set trs = Nothing
ElseIf Request("doorders") <> "" Then
If Not IsNumeric(Request("doorders")) Then
NC_Admin.Error_Msg ("非法的参数!")
Exit Sub
ElseIf CInt(Request("doorders")) = 0 Then
NC_Admin.Error_Msg ("请选择要下降的数字!")
Exit Sub
End If
Set Rs = Newasp.Execute("select ParentID,orders,strparent,child from NC_SoftSort where sortid=" & Request("editID"))
ParentID = Rs(0)
orders = Rs(1)
strParent = Rs(2) & "," & Request("editID")
Child = Rs(3)
i = 0
If Child > 0 Then
Set Rs = Newasp.Execute("select count(*) from NC_SoftSort where strparent like '%" & strParent & "%'")
oldorders = Rs(0)
Else
oldorders = 0
End If
Set Rs = Newasp.Execute("select sortid,orders,child,strparent from NC_SoftSort where ParentID=" & ParentID & " and orders>" & orders & " order by orders")
Do While Not Rs.EOF
i = i + 1
If CInt(Request("doorders")) >= i Then
If Rs(2) > 0 Then
ii = 0
Set trs = Newasp.Execute("select sortid,orders from NC_SoftSort where strparent like '%" & Rs(3) & "," & Rs(0) & "%' order by orders")
If Not (trs.EOF And trs.bof) Then
Do While Not trs.EOF
ii = ii + 1
Newasp.Execute ("update NC_SoftSort set orders=" & orders & "+" & ii & " where sortid=" & trs(0))
trs.movenext
Loop
End If
End If
Newasp.Execute ("update NC_SoftSort set orders=" & orders & " where sortid=" & Rs(0))
If CInt(Request("doorders")) = i Then doorders = Rs(1)
End If
orders = Rs(1)
Rs.movenext
Loop
Newasp.Execute ("update NC_SoftSort set orders=" & doorders & " where sortid=" & Request("editID"))
If Child > 0 Then
i = doorders
Set Rs = Newasp.Execute("select sortid from NC_SoftSort where strparent like '%" & strParent & "%' order by orders")
Do While Not Rs.EOF
i = i + 1
Newasp.Execute ("update NC_SoftSort set orders=" & i & " where sortid=" & Rs(0))
Rs.movenext
Loop
End If
End If
Set Rs = Newasp.Execute("select ID from NC_Template")
Do While Not Rs.EOF
Newasp.DelCahe ("SortingList" & Rs(0))
Newasp.DelCahe ("SortingMenu" & Rs(0))
Rs.movenext
Loop
Set Rs = Nothing
Set trs = Nothing
Newasp.DelCahe "SortingJumpMenu"
Newasp.DelCahe "SortingJumpList"
Response.redirect "admin_sorting.asp?action=boardorders"
End Sub
Private Sub RestoreBoard()
i = 0
Set Rs = Newasp.Execute("select sortid from NC_SoftSort order by rootid,orders")
Do While Not Rs.EOF
i = i + 1
Newasp.Execute ("update NC_SoftSort set rootid=" & i & ",depth=0,orders=0,ParentID=0,strparent='0',child=0 where sortid=" & Rs(0))
Rs.movenext
Loop
Set Rs = Newasp.Execute("select ID from NC_Template")
Do While Not Rs.EOF
Newasp.DelCahe ("SortingList" & Rs(0))
Newasp.DelCahe ("SortingMenu" & Rs(0))
Rs.movenext
Loop
Set Rs = Nothing
Newasp.DelCahe "SortingJumpMenu"
Newasp.DelCahe "SortingJumpList"
NC_Admin.Succeed_Msg ("复位成功,请返回做分类归属设置。")
End Sub
Private Function CreateNewFolder(FolderID, depths)
Dim FSO, FolderPath, FolderDir
If CInt(Newasp.Setting(5)) = 1 Then Exit Function
FolderPath = Newasp.SetupDir & "Sorting/Catalog" & FolderID
FolderDir = Newasp.SetupDir & "Software/Catalog" & FolderID
If Not Newasp.IsObjectFSO(Newasp.Script_FSO) Then
Response.Write "<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)! 文件夹没有创建成功!</font></b>"
Exit Function
Else
Set FSO = Server.CreateObject(Newasp.Script_FSO)
If FSO.FolderExists(Server.MapPath(FolderPath)) = False Then
FSO.CreateFolder Server.MapPath(FolderPath)
End If
If CLng(depths) <> 0 Then
If FSO.FolderExists(Server.MapPath(FolderDir)) = False Then
FSO.CreateFolder Server.MapPath(FolderDir)
End If
End If
Set FSO = Nothing
End If
End Function
Private Function DelFolder(FolderID)
Dim FSO, FolderPath, FolderDir
If CInt(Newasp.Setting(5)) = 1 Then Exit Function
FolderPath = Newasp.SetupDir & "Sorting/Catalog" & FolderID
FolderDir = Newasp.SetupDir & "Software/Catalog" & FolderID
Set FSO = Server.CreateObject(Newasp.Script_FSO)
If FSO.FolderExists(Server.MapPath(FolderPath)) Then
FSO.DeleteFolder Server.MapPath(FolderPath), True
End If
If FSO.FolderExists(Server.MapPath(FolderDir)) Then
FSO.DeleteFolder Server.MapPath(FolderDir), True
End If
Set FSO = Nothing
End Function
Private Sub MoveSorting()
response.Write "<form method=""POST"" action=""?action=savemove"">"& vbCrLf
response.Write "<TABLE width='100%' align=center cellpadding=3 cellspacing=1 border=0 class=tableBorder>"& vbCrLf
response.Write "<TR>"& vbCrLf
response.Write " <TH colspan=4>分类批量移动</TH>"& vbCrLf
response.Write "</TR>"& vbCrLf
response.Write "<TR>"& vbCrLf
response.Write " <TD class=forumRowHighlight align=right>请选择要移动的分类:</TD>"& vbCrLf
response.Write " <TD class=forumRow>"& vbCrLf
response.Write SortJumpList
response.Write " </TD>"& vbCrLf
response.Write " <TD class=forumRowHighlight align=right>移动到的分类:</TD>"& vbCrLf
response.Write " <TD class=forumRow>"& vbCrLf
srtSortingList = Newasp.SortingJumpList
srtSortingList = Replace(srtSortingList, "{SortID=" & Request("sortid") & "}", "selected")
Response.Write srtSortingList
response.Write " </TD>"& vbCrLf
response.Write "</TR>"& vbCrLf
response.Write "<TR>"& vbCrLf
response.Write " <TD class=forumRow colspan=4 align=center><input type=""button"" name=""Submit1"" onclick=""javascript:history.go(-1)"" value=""返回上一页"" class=button> "& vbCrLf
response.Write " <input type=submit name=Submit value=""分类批量移动"" class=button></TD>"& vbCrLf
response.Write "</TR>"& vbCrLf
response.Write "</TABLE>"& vbCrLf
response.Write "</form>"& vbCrLf
End Sub
Private Sub SaveMove()
Dim newclass, SortingID
If Len(Request.Form("SortingID")) = 0 Then
ErrMsg = "<li>请选择要移动的分类,不能选择一级分类!"
Founderr = True
Exit Sub
Else
SortingID = Request.Form("SortingID")
End If
newclass = Split(Trim(Request.Form("sortid")), ",")
If Len(Request.Form("sortid")) <> 0 Then
Newasp.Execute ("update NC_SoftInfo set rootid='" & newclass(0) & "',sortid='" & newclass(1) & "',SortName='" & newclass(2) & "' where sortid = "& SortingID)
NC_Admin.Succeed_Msg ("<li>批量移动操作成功!")
Else
ErrMsg = "<li>不能移动到一级分类,请选择下一级分类!"
Founderr = True
Exit Sub
End If
End Sub
Public Function SortJumpList()
Dim CacheJumpList, SQL, Rs1, i
CacheJumpList = "<select name=""SortingID"" size=""1"">" & vbCrLf
Set Rs1 = Server.CreateObject("Adodb.recordset")
SQL = "select * from NC_SoftSort order by rootid,orders"
Rs1.Open SQL, Conn, 1, 1
Newasp.SqlQueryNum = Newasp.SqlQueryNum + 1
Do While Not Rs1.EOF
If Rs1("depth") = 0 Then
CacheJumpList = CacheJumpList & "<option value="""" "
Else
CacheJumpList = CacheJumpList & "<option value='" & Rs1("sortid") & "'"
End If
CacheJumpList = CacheJumpList & ">"
If Rs1("depth") = 1 Then CacheJumpList = CacheJumpList & " ├ "
If Rs1("depth") > 1 Then
For i = 2 To Rs1("depth")
CacheJumpList = CacheJumpList & " "
Next
CacheJumpList = CacheJumpList & " ├ "
End If
CacheJumpList = CacheJumpList & Rs1("SortName") & "</option>" & vbCrLf
Rs1.movenext
Loop
Rs1.Close
Set Rs1 = Nothing
CacheJumpList = CacheJumpList & "</select>"
SortJumpList = CacheJumpList
End Function
%>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?