<%@language=vbscript codepage=936 %> <% option explicit response.buffer=true Const PurviewLevel=2 Const CheckChannelID=2 Const PurviewLevel_Article=1 %> <% dim Action,ParentID,SkinID,LayoutID,BrowsePurview,AddPurview,i,FoundErr,ErrMsg dim SkinCount,LayoutCount Action=trim(Request("Action")) ParentID=trim(request("ParentID")) if ParentID="" then ParentID=0 else ParentID=CLng(ParentID) end if %> 文章栏目管理
文 章 栏 目 管 理
管理导航： 文章栏目管理首页 | 添加文章栏目 | 一级栏目排序 | N级栏目排序 | 复位所有文章栏目 | 文章栏目合并
<% if Action="Add" then call AddClass() elseif Action="SaveAdd" then call SaveAdd() elseif Action="Modify" then call Modify() elseif Action="SaveModify" then call SaveModify() elseif Action="Move" then call MoveClass() elseif Action="SaveMove" then call SaveMove() elseif Action="Del" then call DeleteClass() elseif Action="Clear" then call ClearClass() elseif Action="UpOrder" then call UpOrder() elseif Action="DownOrder" then call DownOrder() elseif Action="Order" then call Order() elseif Action="UpOrderN" then call UpOrderN() elseif Action="DownOrderN" then call DownOrderN() elseif Action="OrderN" then call OrderN() elseif Action="Reset" then call Reset() elseif Action="SaveReset" then call SaveReset() elseif Action="Unite" then call Unite() elseif Action="SaveUnite" then call SaveUnite() else call main() end if if FoundErr=True then call WriteErrMsg() end if call CloseConn() sub main() dim arrShowLine(10) for i=0 to ubound(arrShowLine) arrShowLine(i)=False next dim sqlClass,rsClass,i,iDepth sqlClass="select * From ArticleClass order by RootID,OrderID" set rsClass=server.CreateObject("adodb.recordset") rsClass.open sqlClass,conn,1,1 %>
<% do while not rsClass.eof %> <% rsClass.movenext loop %>
栏目名称 管理员 栏目属性 浏览权限 添加权限 操作选项
<% iDepth=rsClass("Depth") if rsClass("NextID")>0 then arrShowLine(iDepth)=True else arrShowLine(iDepth)=False end if if iDepth>0 then for i=1 to iDepth if i=iDepth then if rsClass("NextID")>0 then response.write "" else response.write "" end if else if arrShowLine(i)=True then response.write "" else response.write "" end if end if next end if if rsClass("Child")>0 then response.write "" else response.write "" end if if rsClass("Depth")=0 then response.write "" end if response.write "" & rsClass("ClassName") & "" if rsClass("Child")>0 then response.write "（" & rsClass("Child") & "）" end if 'response.write "  " & rsClass("ClassID") & "," & rsClass("PrevID") & "," & rsClass("NextID") & "," & rsClass("ParentID") & "," & rsClass("RootID") %> <% if rsClass("ClassMaster")<>"" then response.write rsClass("ClassMaster") else response.write " " end if %> <% if rsClass("LinkUrl")<>"" then response.write "外部，" else response.write "系统，" end if if rsClass("IsElite")=True then response.write "推荐" else response.write "普通" end if %> <% select case rsClass("BrowsePurview") case 9999 response.write "游客" case 999 response.write "注册用户" case 99 response.write "收费用户" case 9 response.write "VIP用户" case 5 response.write "管理员" end select%> <% select case rsClass("AddPurview") case 999 response.write "注册用户" case 99 response.write "收费用户" case 9 response.write "VIP用户" case 5 response.write "管理员" end select%> ">添加子栏目 | ">修改设置 | ">移动栏目 | " onClick="return ConfirmDel3();">清空 | " onClick="<%if rsClass("Child")>0 then%>return ConfirmDel1();<%else%>return ConfirmDel2();<%end if%>">删除


<% end sub sub AddClass() %>
添 加 文 章 栏 目
所属栏目：
不能指定为外部栏目
栏目名称：
栏目目录：
只能是英文，不能带空格或“\”、“/”等符号。
只在生成静态页面时使用。
栏目文件别名：
别名不要加后缀,但实际页面必须是.asp后缀文件		 .asp
栏目说明：
 鼠标移至栏目名称上时将显示设定的说明文字
是否是推荐栏目：
推荐栏目将在首页及此栏目的父栏目上显示文章列表		 是     否
是否在顶部导航栏显示：
此选项只对一级栏目有效。		 是     否
栏目内的文章在首页的显示样式：
此选项只对一级栏目有效
栏目配色模板：
相关模板中包含CSS、颜色、图片等信息
版面设计模板：
相关模板中包含了栏目设计的版式等信息，如果是自行添加的设计模板，可能会导致“栏目配色模板”失效。
栏目图片地址：
图片会显示在栏目前面。注意图片大小。		 （预留功能）
栏目编辑：
多个编辑请用“|”分隔，如：webboy|dilys|sws2000
无需添加“文章总编”以上级别的管理员
管理员权限采用权限继承制度
栏目链接地址：
如果想将栏目链接到外部地址，请输入完整的URL地址，否则请保持为空。
栏目浏览权限：
只有具有相应权限的人才能浏览此栏目中的文章。
栏目发表文章权限：
只有具有相应权限的人才能在此栏目中发表文章。
此栏目下的文章的默认配色风格：
相关模板中包含CSS、颜色、图片等信息
此栏目下的文章的默认模板：
style="cursor:hand;">   <%if SkinCount=0 then response.write "
  • 请先添加栏目配色模板
    • " if SkinCount=0 then response.write "
  • 请先添加栏目栏目设计模板
    • " %>
    <% end sub sub Modify() dim ClassID,sql,rsClass,i ClassID=trim(request("ClassID")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " exit sub else ClassID=CLng(ClassID) end if sql="select * From ArticleClass where ClassID=" & ClassID set rsClass=server.CreateObject ("Adodb.recordset") rsClass.open sql,conn,1,3 if rsClass.bof and rsClass.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 找不到指定的栏目！
    • " else %>
    <%if rsClass("Child") > 0 then%> <%end if%>
    修 改 文 章 栏 目
    所属栏目：
    如果你想改变所属栏目，请点此移动栏目    		 <% if rsClass("ParentID")<=0 then response.write "无（作为一级栏目）" else dim rsParentClass,sqlParentClass sqlParentClass="Select * From ArticleClass where ClassID in (" & rsClass("ParentPath") & ") order by Depth" set rsParentClass=server.CreateObject("adodb.recordset") rsParentClass.open sqlParentClass,conn,1,1 do while not rsParentClass.eof for i=1 to rsParentClass("Depth") response.write "   " next if rsParentClass("Depth")>0 then response.write "└" end if response.write " " & rsParentClass("ClassName") & "
    " rsParentClass.movenext loop rsParentClass.close set rsParentClass=nothing end if %>
    栏目名称： " size="37" maxlength="20"> ">
    栏目目录：
    只能是英文，不能带空格或“\”、“/”等符号。
    只在生成静态页面时使用。    		 ">
    栏目文件别名：
    别名不要加后缀,但实际页面必须是.asp后缀文件    		 " size="37" maxlength="20">.asp
    栏目说明：
     鼠标移至栏目名称上时将显示设定的说明文字
    是否是推荐栏目：
    推荐栏目将在首页及此栏目的父栏目上显示文章列表    		 > 是     > 否
    是否在顶部导航栏显示：
    只选项只对一级栏目有效。    		 > 是     > 否
    是否显示文章列表： > 是     > 否
    栏目内的文章在首页的显示样式：
    此选项只对一级栏目有效
    栏目配色模板：
    相关模板中包含CSS、颜色、图片等信息
    版面设计模板：
    相关模板中包含了栏目设计的版式等信息，如果是自行添加的设计模板，可能会导致“栏目配色模板”失效。
    栏目图片地址：
    图片会显示在栏目前面。注意图片大小。    		 " size="37" maxlength="255"> （预留功能）
    栏目编辑：
    多个编辑请用“|”分隔，如：webboy|dilys|sws2000
    无需添加“文章总编”以上级别的管理员
    管理员权限采用权限继承制度    		 " size="37" maxlength="100" disabled>
    栏目链接地址：
    如果想将栏目链接到外部地址，请输入完整的URL地址，否则请保持为空。    		 " size="37" maxlength="255">
    栏目浏览权限：
    只有具有相应权限的人才能浏览此栏目中的文章。
    栏目发表文章权限：
    只有具有相应权限的人才能在此栏目中发表文章。
    此栏目下的文章的默认配色风格：
    相关模板中包含CSS、颜色、图片等信息
    此栏目下的文章的默认模板：
    style="cursor:hand;">   <%if SkinCount=0 then response.write "
  • 请先添加栏目配色模板
    • " if SkinCount=0 then response.write "
  • 请先添加栏目栏目设计模板
    • " %>
    <% end if rsClass.close set rsClass=nothing end sub sub MoveClass() dim ClassID,sql,rsClass,i dim SkinID,LayoutID,BrowsePurview,AddPurview ClassID=trim(request("ClassID")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " exit sub else ClassID=CLng(ClassID) end if sql="select * From ArticleClass where ClassID=" & ClassID set rsClass=server.CreateObject ("Adodb.recordset") rsClass.open sql,conn,1,3 if rsClass.bof and rsClass.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 找不到指定的栏目！
    • " else %>
    移 动 文 章 栏 目
    栏目名称： <%=rsClass("ClassName")%> ">
    当前所属栏目： <% if rsClass("ParentID")<=0 then response.write "无（作为一级栏目）" else dim rsParent,sqlParent sqlParent="Select * From ArticleClass where ClassID in (" & rsClass("ParentPath") & ") order by Depth" set rsParent=server.CreateObject("adodb.recordset") rsParent.open sqlParent,conn,1,1 do while not rsParent.eof for i=1 to rsParent("Depth") response.write "   " next if rsParent("Depth")>0 then response.write "└" end if response.write " " & rsParent("ClassName") & "
    " rsParent.movenext loop rsParent.close set rsParent=nothing end if %>
    移动到：
    不能指定为当前栏目的下属子栏目
    不能指定为外部栏目
     
    <% end if rsClass.close set rsClass=nothing end sub sub Order() dim sqlClass,rsClass,i,iCount,j sqlClass="select * From ArticleClass where ParentID=0 order by RootID" set rsClass=server.CreateObject("adodb.recordset") rsClass.open sqlClass,conn,1,1 iCount=rsClass.recordcount %>
    <% j=1 do while not rsClass.eof %> <% if j>1 then response.write "" else response.write "" end if if iCount>j then response.write "" else response.write "" end if %> <% j=j+1 rsClass.movenext loop %>
    一 级 栏 目 排 序
     <%=rsClass("ClassName")%>
    " response.write "" response.write "" response.write " " response.write " 
    " response.write "" response.write "" response.write " " response.write "  
    <% rsClass.close set rsClass=nothing end sub sub OrderN() dim sqlClass,rsClass,i,iCount,trs,UpMoveNum,DownMoveNum sqlClass="select * From ArticleClass order by RootID,OrderID" set rsClass=server.CreateObject("adodb.recordset") rsClass.open sqlClass,conn,1,1 %>
    <% do while not rsClass.eof %> <% if rsClass("ParentID")>0 then '如果不是一级栏目，则算出相同深度的栏目数目，得到该栏目在相同深度的栏目中所处位置（之上或者之下的栏目数） '所能提升最大幅度应为For i=1 to 该版之上的版面数 set trs=conn.execute("select count(ClassID) From ArticleClass where ParentID="&rsClass("ParentID")&" and OrderID<"&rsClass("OrderID")&"") UpMoveNum=trs(0) if isnull(UpMoveNum) then UpMoveNum=0 if UpMoveNum>0 then response.write "" else response.write "" end if trs.close '所能降低最大幅度应为For i=1 to 该版之下的版面数 set trs=conn.execute("select count(ClassID) From ArticleClass where ParentID="&rsClass("ParentID")&" and orderID>"&rsClass("orderID")&"") DownMoveNum=trs(0) if isnull(DownMoveNum) then DownMoveNum=0 if DownMoveNum>0 then response.write "" else response.write "" end if trs.close else response.write "" end if %> <% UpMoveNum=0 DownMoveNum=0 rsClass.movenext loop %>
    N 级 栏 目 排 序
    <% for i=1 to rsClass("Depth") response.write "   " next if rsClass("Child")>0 then response.write "" else response.write "" end if if rsClass("ParentID")=0 then response.write "" end if response.write rsClass("ClassName") if rsClass("Child")>0 then response.write "(" & rsClass("Child") & ")" end if %>
    " response.write "" response.write " " response.write " 
    " response.write "" response.write " " response.write "   
    <% rsClass.close set rsClass=nothing end sub sub Reset() %>
    复 位 所 有 文 章 栏 目
    注意：
        如果选择复位所有栏目，则所有栏目都将作为一级栏目，这时您需要重新对各个栏目进行归属的基本设置。不要轻易使用该功能，仅在做出了错误的设置而无法复原栏目之间的关系和排序的时候使用。
     
    <% end sub sub Unite() %>
    文 章 栏 目 合 并
      将栏目 合并到

               
    注意事项：
        所有操作不可逆，请慎重操作！！！
        不能在同一个栏目内进行操作，不能将一个栏目合并到其下属栏目中。目标栏目中不能含有子栏目。
        合并后您所指定的栏目（或者包括其下属栏目）将被删除，所有文章将转移到目标栏目中。
    <% end sub %> <% sub CopyFile(source,destination) Dim fso Set fso = CreateObject("Scripting.FileSystemObject") source = server.mappath(source) if not fso.FileExists(source) then exit sub end if destination = server.mappath(destination) if fso.FileExists(destination) then fso.DeleteFile destination end if fso.CopyFile source,destination end sub sub SaveAdd() dim ClassID,ClassName,IsElite,ShowOnTop,Setting,Readme,ClassMaster,ClassPicUrl,LinkUrl,PrevOrderID,LayoutID,DefaultItemTemplate,DefaultItemSkin,ClassDir,Repetition dim sql,rs,trs dim RootID,ParentDepth,ParentPath,ParentStr,ParentName,MaxClassID,MaxRootID dim PrevID,NextID,Child ClassName=trim(request("ClassName")) ClassMaster=trim(request("ClassMaster")) IsElite=trim(request("IsElite")) ShowOnTop=trim(request("ShowOnTop")) Setting=trim(request("Setting")) Readme=trim(request("Readme")) ClassPicUrl=trim(request("ClassPicUrl")) LinkUrl=trim(request("LinkUrl")) SkinID=Trim(request("SkinID")) LayoutID=trim(request("LayoutID")) BrowsePurview=trim(request("BrowsePurview")) AddPurview=trim(request("AddPurview")) DefaultItemTemplate=trim(request("DefaultItemTemplate")) DefaultItemSkin=trim(request("DefaultItemSkin")) ClassDir=trim(request("ClassDir")) Repetition=trim(request("Repetition")) if ClassName="" then FoundErr=True ErrMsg=ErrMsg & "
  • 栏目名称不能为空！
    • " end if if IsElite="Yes" then IsElite=True else IsElite=False end if if ShowOnTop="Yes" then ShowOnTop=True else ShowOnTop=False end if if SkinID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定栏目配色模板
    • " else SkinID=CLng(SkinID) end if if LayoutID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定版面设计模板
    • " else LayoutID=CLng(LayoutID) end if if ClassMaster<>"" then 'call AddMaster(ClassMaster) end if if FoundErr=True then exit sub end if set rs = conn.execute("select Max(ClassID) From ArticleClass") MaxClassID=rs(0) if isnull(MaxClassID) then MaxClassID=0 end if rs.close ClassID=MaxClassID+1 set rs=conn.execute("select max(rootid) From ArticleClass") MaxRootID=rs(0) if isnull(MaxRootID) then MaxRootID=0 end if rs.close RootID=MaxRootID+1 if ParentID>0 then sql="select * From ArticleClass where ClassID=" & ParentID & "" rs.open sql,conn,1,1 if rs.bof and rs.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 所属栏目已经被删除！
    • " else if rs("LinkUrl")<>"" then FoundErr=True ErrMsg=ErrMsg & "
  • 不能指定外部栏目为所属栏目！
    • " end if end if if FoundErr=True then rs.close set rs=nothing exit sub else RootID=rs("RootID") ParentName=rs("ClassName") ParentDepth=rs("Depth") ParentPath=rs("ParentPath") Child=rs("Child") ParentPath=ParentPath & "," & ParentID '得到此栏目的父级栏目路径 PrevOrderID=rs("OrderID") if Child>0 then dim rsPrevOrderID '得到与本栏目同级的最后一个栏目的OrderID set rsPrevOrderID=conn.execute("select Max(OrderID) From ArticleClass where ParentID=" & ParentID) PrevOrderID=rsPrevOrderID(0) set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & ParentID & " and OrderID=" & PrevOrderID) PrevID=trs(0) '得到同一父栏目但比本栏目级数大的子栏目的最大OrderID，如果比前一个值大，则改用这个值。 set rsPrevOrderID=conn.execute("select Max(OrderID) From ArticleClass where ParentPath like '" & ParentPath & ",%'") if (not(rsPrevOrderID.bof and rsPrevOrderID.eof)) then if not IsNull(rsPrevOrderID(0)) then if rsPrevOrderID(0)>PrevOrderID then PrevOrderID=rsPrevOrderID(0) end if end if end if else PrevID=0 end if end if rs.close else if MaxRootID>0 then set trs=conn.execute("select ClassID from ArticleClass where RootID=" & MaxRootID & " and Depth=0") PrevID=trs(0) trs.close else PrevID=0 end if PrevOrderID=0 ParentPath="0" end if sql="Select * From ArticleClass Where ParentID=" & ParentID & " AND ClassName='" & ClassName & "'" set rs=server.CreateObject("adodb.recordset") rs.open sql,conn,1,1 if not(rs.bof and rs.eof) then FoundErr=True if ParentID=0 then ErrMsg=ErrMsg & "
  • 已经存在一级栏目：" & ClassName & "
    • " else ErrMsg=ErrMsg & "
  • “" & ParentName & "”中已经存在子栏目“" & ClassName & "”！
    • " end if rs.close set rs=nothing exit sub end if rs.close sql="Select top 1 * From ArticleClass" rs.open sql,conn,1,3 rs.addnew rs("ClassID")=ClassID rs("ClassName")=ClassName rs("IsElite")=IsElite rs("ShowOnTop")=ShowOnTop rs("Setting")=Clng(Setting) 'rs("ClassMaster")=ClassMaster rs("RootID")=RootID rs("ParentID")=ParentID if ParentID>0 then rs("Depth")=ParentDepth+1 else rs("Depth")=0 end if rs("ParentPath")=ParentPath rs("OrderID")=PrevOrderID rs("Child")=0 rs("Readme")=Readme rs("ClassPicUrl")=ClassPicUrl rs("LinkUrl")=LinkUrl rs("SkinID")=SkinID rs("LayoutID")=LayoutID rs("BrowsePurview")=Cint(BrowsePurview) rs("AddPurview")=Cint(AddPurview) rs("PrevID")=PrevID rs("NextID")=0 rs("DefaultItemTemplate")=DefaultItemTemplate rs("DefaultItemSkin")=DefaultItemSkin rs("ClassDir")=ClassDir rs("Repetition")=Repetition rs.update rs.Close set rs=Nothing '更新与本栏目同一父栏目的上一个栏目的“NextID”字段值 if PrevID>0 then conn.execute("update ArticleClass set NextID=" & ClassID & " where ClassID=" & PrevID) end if if ParentID>0 then '更新其父类的子栏目数 conn.execute("update ArticleClass set child=child+1 where ClassID="&ParentID) '更新该栏目排序以及大于本需要和同在本分类下的栏目排序序号 conn.execute("update ArticleClass set OrderID=OrderID+1 where rootid=" & rootid & " and OrderID>" & PrevOrderID) conn.execute("update ArticleClass set OrderID=" & PrevOrderID & "+1 where ClassID=" & ClassID) end if call CopyFile("../Repetition.asp","../"&Repetition&".asp") call CloseConn() Response.Redirect "Admin_Class_Article.asp" end sub sub SaveModify() dim ClassName,Readme,IsElite,ShowOnTop,Setting,ClassMaster,ClassPicUrl,LinkUrl,SkinID,LayoutID,BrowsePurview,AddPurview,DefaultItemTemplate,DefaultItemSkin,ClassDir,Repetition dim trs,rs dim ClassID,sql,rsClass,i dim SkinCount,LayoutCount ClassID=trim(request("ClassID")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " else ClassID=CLng(ClassID) end if ClassName=trim(request("ClassName")) IsElite=trim(request("IsElite")) ShowOnTop=trim(request("ShowOnTop")) Setting=trim(request("Setting")) ClassMaster=trim(request("ClassMaster")) Readme=trim(request("Readme")) ClassPicUrl=trim(request("ClassPicUrl")) LinkUrl=trim(request("LinkUrl")) SkinID=Trim(request("SkinID")) LayoutID=trim(request("LayoutID")) BrowsePurview=trim(request("BrowsePurview")) AddPurview=trim(request("AddPurview")) DefaultItemTemplate=trim(request("DefaultItemTemplate")) DefaultItemSkin=trim(request("DefaultItemSkin")) ClassDir=trim(request("ClassDir")) Repetition=trim(request("Repetition")) if ClassName="" then FoundErr=True ErrMsg=ErrMsg & "
  • 栏目名称不能为空！
    • " end if if FoundErr=True then exit sub end if sql="select * From ArticleClass where ClassID=" & ClassID set rsClass=server.CreateObject ("Adodb.recordset") rsClass.open sql,conn,1,3 if rsClass.bof and rsClass.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 找不到指定的栏目！
    • " rsClass.close set rsClass=nothing exit sub end if if rsClass("Child")>0 and LinkUrl<>"" then FoundErr=True ErrMsg=ErrMsg & "
  • 本栏目有子栏目，所以不能设为外部链接地址。
    • " end if if IsElite="Yes" then IsElite=True else IsElite=False end if if ShowOnTop="Yes" then ShowOnTop=True else ShowOnTop=False end if if SkinID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定栏目配色模板
    • " else SkinID=Clng(SkinID) end if if LayoutID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定版面设计模板
    • " else LayoutID=CLng(LayoutID) end if if ClassMaster<>"" and ClassMaster<>rsClass("ClassMaster") then 'call AddMaster(ClassMaster) end if if FoundErr=True then rsClass.close set rsClass=nothing exit sub end if rsClass("ClassName")=ClassName rsClass("IsElite")=IsElite rsClass("ShowOnTop")=ShowOnTop rsClass("Setting")=Clng(Setting) 'rsClass("ClassMaster")=ClassMaster rsClass("Readme")=Readme rsClass("ClassPicUrl")=ClassPicUrl rsClass("LinkUrl")=LinkUrl rsClass("SkinID")=Cint(SkinID) rsClass("LayoutID")=Cint(LayoutID) rsClass("BrowsePurview")=Cint(BrowsePurview) rsClass("AddPurview")=Cint(AddPurview) rsClass("DefaultItemTemplate")=Cint(DefaultItemTemplate) rsClass("DefaultItemSkin")=Cint(DefaultItemSkin) rsClass("ClassDir")=ClassDir rsClass("Repetition")=Repetition rsClass.update rsClass.close set rsClass=nothing set rs=nothing set trs=nothing call CopyFile("../Repetition.asp","../"&Repetition&".asp") call CloseConn() Response.Redirect "Admin_Class_Article.asp" end sub '删除类(包含其子目录) sub DeleteClass() dim rs,ClassID dim fso,Repetition,destination ClassID=trim(Request("ClassID")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " exit sub else ClassID=CLng(ClassID) end if '修改相邻目录关联数据 set rs = conn.execute("select PrevID,NextID,Depth,ParentID,Repetition From ArticleClass where ClassID=" & ClassID) if not rs.eof then '修改上一栏目的NextID和下一栏目的PrevID if rs(0)>0 then conn.execute("update ArticleClass set NextID=" & rs(1) & " where ClassID=" & rs(0)) end if if rs(1)>0 then conn.execute("update ArticleClass set PrevID=" & rs(0) & " where ClassID=" & rs(1)) end if '修改上级目录的子目录数 if rs(2)>0 then conn.execute("update ArticleClass set child=child-1 where ClassID=" & rs(3)) end if if VarType(rs(4)) = vbNull then Repetition = "" else Repetition = rs(4) end if end if rs.close set rs=nothing '删除本目录及其子目录下所有的评论 conn.execute("delete from ArticleComment where ClassID in (select ClassID From ArticleClass where ClassID=" & ClassID & " OR (','+ParentPath+',') like '%," & ClassID & ",%')") '删除本目录及其子目录下所有的文章 conn.execute("delete From Article where ClassID in (select ClassID From ArticleClass where ClassID=" & ClassID & " OR (','+ParentPath+',') like '%," & ClassID & ",%')") '删除本目录及其子目录 conn.execute("delete From ArticleClass where ClassID=" & ClassID & " OR (','+ParentPath+',') like '%," & ClassID & ",%'") if Repetition <> "" then Set fso = CreateObject("Scripting.FileSystemObject") destination = server.mappath("../"&Repetition&".asp") if fso.FileExists(destination) then fso.DeleteFile destination end if end if call CloseConn() response.redirect "Admin_Class_Article.asp" end sub sub ClearClass() dim strClassID,rs,trs,SuccessMsg,ClassID ClassID=trim(Request("ClassID")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " exit sub else ClassID=CLng(ClassID) end if strClassID=cstr(ClassID) set rs=conn.execute("select ClassID,Child,ParentPath from ArticleClass where ClassID=" & ClassID) if rs.bof and rs.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 栏目不存在，或者已经被删除
    • " exit sub end if if rs(1)>0 then set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & rs(0)) do while not trs.eof strClassID=strClassID & "," & trs(0) trs.movenext loop trs.close set trs=conn.execute("select ClassID from ArticleClass where ParentPath like '" & rs(2) & "," & rs(0) & ",%'") do while not trs.eof strClassID=strClassID & "," & trs(0) trs.movenext loop trs.close set trs=nothing end if rs.close set rs=nothing conn.execute("update Article set Deleted=True where ClassID in (" & strClassID & ")") conn.execute("delete from Article where ClassID in (" & strClassID & ")") SuccessMsg="此栏目（包括子栏目）的所有文章已经被移到回收站中！" call WriteSuccessMsg(SuccessMsg) end sub sub SaveMove() dim ClassID,sql,rsClass,i dim rParentID dim trs,rs dim ParentID,RootID,Depth,Child,ParentPath,ParentName,iParentID,iParentPath,PrevOrderID,PrevID,NextID ClassID=trim(request("ClassID")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " exit sub else ClassID=CLng(ClassID) end if sql="select * From ArticleClass where ClassID=" & ClassID set rsClass=server.CreateObject ("Adodb.recordset") rsClass.open sql,conn,1,3 if rsClass.bof and rsClass.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 找不到指定的栏目！
    • " rsClass.close set rsClass=nothing exit sub end if rParentID=trim(request("ParentID")) if rParentID="" then rParentID=0 else rParentID=CLng(rParentID) end if if rsClass("ParentID")<>rParentID then '更改了所属栏目，则要做一系列检查 if rParentID=rsClass("ClassID") then FoundErr=True ErrMsg=ErrMsg & "
  • 所属栏目不能为自己！
    • " end if '判断所指定的栏目是否为外部栏目或本栏目的下属栏目 if rsClass("ParentID")=0 then if rParentID>0 then set trs=conn.execute("select rootid From ArticleClass where LinkUrl='' and ClassID="&rParentID) if trs.bof and trs.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 不能指定外部栏目为所属栏目
    • " else if rsClass("rootid")=trs(0) then FoundErr=True ErrMsg=ErrMsg & "
  • 不能指定该栏目的下属栏目作为所属栏目
    • " end if end if trs.close set trs=nothing end if else set trs=conn.execute("select ClassID From ArticleClass where ParentPath like '"&rsClass("ParentPath")&"," & rsClass("ClassID") & "%' and ClassID="&rParentID) if not (trs.eof and trs.bof) then FoundErr=True ErrMsg=ErrMsg & "
  • 您不能指定该栏目的下属栏目作为所属栏目
    • " end if trs.close set trs=nothing end if end if if FoundErr=True then rsClass.close set rsClass=nothing exit sub end if if rsClass("ParentID")=0 then ParentID=rsClass("ClassID") iParentID=0 else ParentID=rsClass("ParentID") iParentID=rsClass("ParentID") end if Depth=rsClass("Depth") Child=rsClass("Child") RootID=rsClass("RootID") ParentPath=rsClass("ParentPath") PrevID=rsClass("PrevID") NextID=rsClass("NextID") rsClass.close set rsClass=nothing '假如更改了所属栏目 '需要更新其原来所属栏目信息，包括深度、父级ID、栏目数、排序、继承版主等数据 '需要更新当前所属栏目信息 '继承版主数据需要另写函数进行更新--取消，在前台可用ClassID in ParentPath来获得 dim mrs,MaxRootID set mrs=conn.execute("select max(rootid) From ArticleClass") MaxRootID=mrs(0) set mrs=nothing if isnull(MaxRootID) then MaxRootID=0 end if dim k,nParentPath,mParentPath dim ParentSql,ClassCount dim rsPrevOrderID if clng(parentid)<>rParentID and not (iParentID=0 and rParentID=0) then '假如更改了所属栏目 '更新原来同一父栏目的上一个栏目的NextID和下一个栏目的PrevID if PrevID>0 then conn.execute "update ArticleClass set NextID=" & NextID & " where ClassID=" & PrevID end if if NextID>0 then conn.execute "update ArticleClass set PrevID=" & PrevID & " where ClassID=" & NextID end if if iParentID>0 and rParentID=0 then '如果原来不是一级分类改成一级分类 '得到上一个一级分类栏目 sql="select ClassID,NextID from ArticleClass where RootID=" & MaxRootID & " and Depth=0" set rs=server.CreateObject("Adodb.recordset") rs.open sql,conn,1,3 PrevID=rs(0) '得到新的PrevID rs(1)=ClassID '更新上一个一级分类栏目的NextID的值 rs.update rs.close set rs=nothing MaxRootID=MaxRootID+1 '更新当前栏目数据 conn.execute("update ArticleClass set depth=0,OrderID=0,rootid="&maxrootid&",parentid=0,ParentPath='0',PrevID=" & PrevID & ",NextID=0 where ClassID="&ClassID) '如果有下属栏目，则更新其下属栏目数据。下属栏目的排序不需考虑，只需更新下属栏目深度和一级排序ID(rootid)数据 if child>0 then i=0 ParentPath=ParentPath & "," set rs=conn.execute("select * From ArticleClass where ParentPath like '%"&ParentPath & ClassID&"%'") do while not rs.eof i=i+1 mParentPath=replace(rs("ParentPath"),ParentPath,"") conn.execute("update ArticleClass set depth=depth-"&depth&",rootid="&maxrootid&",ParentPath='"&mParentPath&"' where ClassID="&rs("ClassID")) rs.movenext loop rs.close set rs=nothing end if '更新其原来所属栏目的栏目数，排序相当于剪枝而不需考虑 conn.execute("update ArticleClass set child=child-1 where ClassID="&iParentID) elseif iParentID>0 and rParentID>0 then '如果是将一个分栏目移动到其他分栏目下 '得到当前栏目的下属子栏目数 ParentPath=ParentPath & "," set rs=conn.execute("select count(*) From ArticleClass where ParentPath like '%"&ParentPath & ClassID&"%'") ClassCount=rs(0) if isnull(ClassCount) then ClassCount=1 end if rs.close set rs=nothing '获得目标栏目的相关信息 set trs=conn.execute("select * From ArticleClass where ClassID="&rParentID) if trs("Child")>0 then '得到与本栏目同级的最后一个栏目的OrderID set rsPrevOrderID=conn.execute("select Max(OrderID) From ArticleClass where ParentID=" & trs("ClassID")) PrevOrderID=rsPrevOrderID(0) '得到与本栏目同级的最后一个栏目的ClassID sql="select ClassID,NextID from ArticleClass where ParentID=" & trs("ClassID") & " and OrderID=" & PrevOrderID set rs=server.createobject("adodb.recordset") rs.open sql,conn,1,3 PrevID=rs(0) '得到新的PrevID rs(1)=ClassID '更新上一个栏目的NextID的值 rs.update rs.close set rs=nothing '得到同一父栏目但比本栏目级数大的子栏目的最大OrderID，如果比前一个值大，则改用这个值。 set rsPrevOrderID=conn.execute("select Max(OrderID) From ArticleClass where ParentPath like '" & trs("ParentPath") & "," & trs("ClassID") & ",%'") if (not(rsPrevOrderID.bof and rsPrevOrderID.eof)) then if not IsNull(rsPrevOrderID(0)) then if rsPrevOrderID(0)>PrevOrderID then PrevOrderID=rsPrevOrderID(0) end if end if end if else PrevID=0 PrevOrderID=trs("OrderID") end if '在获得移动过来的栏目数后更新排序在指定栏目之后的栏目排序数据 conn.execute("update ArticleClass set OrderID=OrderID+" & ClassCount & "+1 where rootid=" & trs("rootid") & " and OrderID>" & PrevOrderID) '更新当前栏目数据 conn.execute("update ArticleClass set depth="&trs("depth")&"+1,OrderID="&PrevOrderID&"+1,rootid="&trs("rootid")&",ParentID="&rParentID&",ParentPath='" & trs("ParentPath") & "," & trs("ClassID") & "',PrevID=" & PrevID & ",NextID=0 where ClassID="&ClassID) '如果有子栏目则更新子栏目数据，深度为原来的相对深度加上当前所属栏目的深度 set rs=conn.execute("select * From ArticleClass where ParentPath like '%"&ParentPath&ClassID&"%' order by OrderID") i=1 do while not rs.eof i=i+1 iParentPath=trs("ParentPath") & "," & trs("ClassID") & "," & replace(rs("ParentPath"),ParentPath,"") conn.execute("update ArticleClass set depth=depth-"&depth&"+"&trs("depth")&"+1,OrderID="&PrevOrderID&"+"&i&",rootid="&trs("rootid")&",ParentPath='"&iParentPath&"' where ClassID="&rs("ClassID")) rs.movenext loop rs.close set rs=nothing trs.close set trs=nothing '更新所指向的上级栏目的子栏目数 conn.execute("update ArticleClass set child=child+1 where ClassID="&rParentID) '更新其原父类的子栏目数 conn.execute("update ArticleClass set child=child-1 where ClassID="&iParentID) else '如果原来是一级栏目改成其他栏目的下属栏目 '得到移动的栏目总数 set rs=conn.execute("select count(*) From ArticleClass where rootid="&rootid) ClassCount=rs(0) rs.close set rs=nothing '获得目标栏目的相关信息 set trs=conn.execute("select * From ArticleClass where ClassID="&rParentID) if trs("Child")>0 then '得到与本栏目同级的最后一个栏目的OrderID set rsPrevOrderID=conn.execute("select Max(OrderID) From ArticleClass where ParentID=" & trs("ClassID")) PrevOrderID=rsPrevOrderID(0) sql="select ClassID,NextID from ArticleClass where ParentID=" & trs("ClassID") & " and OrderID=" & PrevOrderID set rs=server.createobject("adodb.recordset") rs.open sql,conn,1,3 PrevID=rs(0) rs(1)=ClassID rs.update set rs=nothing '得到同一父栏目但比本栏目级数大的子栏目的最大OrderID，如果比前一个值大，则改用这个值。 set rsPrevOrderID=conn.execute("select Max(OrderID) From ArticleClass where ParentPath like '" & trs("ParentPath") & "," & trs("ClassID") & ",%'") if (not(rsPrevOrderID.bof and rsPrevOrderID.eof)) then if not IsNull(rsPrevOrderID(0)) then if rsPrevOrderID(0)>PrevOrderID then PrevOrderID=rsPrevOrderID(0) end if end if end if else PrevID=0 PrevOrderID=trs("OrderID") end if '在获得移动过来的栏目数后更新排序在指定栏目之后的栏目排序数据 conn.execute("update ArticleClass set OrderID=OrderID+" & ClassCount &"+1 where rootid=" & trs("rootid") & " and OrderID>" & PrevOrderID) conn.execute("update ArticleClass set PrevID=" & PrevID & ",NextID=0 where ClassID=" & ClassID) set rs=conn.execute("select * From ArticleClass where rootid="&rootid&" order by OrderID") i=0 do while not rs.eof i=i+1 if rs("parentid")=0 then ParentPath=trs("ParentPath") & "," & trs("ClassID") conn.execute("update ArticleClass set depth=depth+"&trs("depth")&"+1,OrderID="&PrevOrderID&"+"&i&",rootid="&trs("rootid")&",ParentPath='"&ParentPath&"',parentid="&rParentID&" where ClassID="&rs("ClassID")) else ParentPath=trs("ParentPath") & "," & trs("ClassID") & "," & replace(rs("ParentPath"),"0,","") conn.execute("update ArticleClass set depth=depth+"&trs("depth")&"+1,OrderID="&PrevOrderID&"+"&i&",rootid="&trs("rootid")&",ParentPath='"&ParentPath&"' where ClassID="&rs("ClassID")) end if rs.movenext loop rs.close set rs=nothing trs.close set trs=nothing '更新所指向的上级栏目栏目数 conn.execute("update ArticleClass set child=child+1 where ClassID="&rParentID) end if end if call CloseConn() Response.Redirect "Admin_Class_Article.asp" end sub sub UpOrder() dim ClassID,sqlOrder,rsOrder,MoveNum,cRootID,tRootID,i,rs,PrevID,NextID ClassID=trim(request("ClassID")) cRootID=Trim(request("cRootID")) MoveNum=trim(request("MoveNum")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " else ClassID=CLng(ClassID) end if if cRootID="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " else cRootID=Cint(cRootID) end if if MoveNum="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " else MoveNum=Cint(MoveNum) if MoveNum=0 then FoundErr=True ErrMsg=ErrMsg & "
  • 请选择要提升的数字！
    • " end if end if if FoundErr=True then exit sub end if '得到本栏目的PrevID,NextID set rs=conn.execute("select PrevID,NextID from ArticleClass where ClassID=" & ClassID) PrevID=rs(0) NextID=rs(1) rs.close set rs=nothing '先修改上一栏目的NextID和下一栏目的PrevID if PrevID>0 then conn.execute "update ArticleClass set NextID=" & NextID & " where ClassID=" & PrevID end if if NextID>0 then conn.execute "update ArticleClass set PrevID=" & PrevID & " where ClassID=" & NextID end if dim mrs,MaxRootID set mrs=conn.execute("select max(rootid) From ArticleClass") MaxRootID=mrs(0)+1 '先将当前栏目移至最后，包括子栏目 conn.execute("update ArticleClass set RootID=" & MaxRootID & " where RootID=" & cRootID) '然后将位于当前栏目以上的栏目的RootID依次加一，范围为要提升的数字 sqlOrder="select * From ArticleClass where ParentID=0 and RootID<" & cRootID & " order by RootID desc" set rsOrder=server.CreateObject("adodb.recordset") rsOrder.open sqlOrder,conn,1,3 if rsOrder.bof and rsOrder.eof then exit sub '如果当前栏目已经在最上面，则无需移动 end if i=1 do while not rsOrder.eof tRootID=rsOrder("RootID") '得到要提升位置的RootID，包括子栏目 conn.execute("update ArticleClass set RootID=RootID+1 where RootID=" & tRootID) i=i+1 if i>MoveNum then rsOrder("PrevID")=ClassID rsOrder.update conn.execute("update ArticleClass set NextID=" & rsOrder("ClassID") & " where ClassID=" & ClassID) exit do end if rsOrder.movenext loop rsOrder.movenext if rsOrder.eof then conn.execute("update ArticleClass set PrevID=0 where ClassID=" & ClassID) else rsOrder("NextID")=ClassID rsOrder.update conn.execute("update ArticleClass set PrevID=" & rsOrder("ClassID") & " where ClassID=" & ClassID) end if rsOrder.close set rsOrder=nothing '然后再将当前栏目从最后移到相应位置，包括子栏目 conn.execute("update ArticleClass set RootID=" & tRootID & " where RootID=" & MaxRootID) call CloseConn() response.Redirect "Admin_Class_Article.asp?Action=Order" end sub sub DownOrder() dim ClassID,sqlOrder,rsOrder,MoveNum,cRootID,tRootID,i,rs,PrevID,NextID ClassID=trim(request("ClassID")) cRootID=Trim(request("cRootID")) MoveNum=trim(request("MoveNum")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 参数不足！
    • " else ClassID=CLng(ClassID) end if if cRootID="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " else cRootID=Cint(cRootID) end if if MoveNum="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " else MoveNum=Cint(MoveNum) if MoveNum=0 then FoundErr=True ErrMsg=ErrMsg & "
  • 请选择要提升的数字！
    • " end if end if if FoundErr=True then exit sub end if '得到本栏目的PrevID,NextID set rs=conn.execute("select PrevID,NextID from ArticleClass where ClassID=" & ClassID) PrevID=rs(0) NextID=rs(1) rs.close set rs=nothing '先修改上一栏目的NextID和下一栏目的PrevID if PrevID>0 then conn.execute "update ArticleClass set NextID=" & NextID & " where ClassID=" & PrevID end if if NextID>0 then conn.execute "update ArticleClass set PrevID=" & PrevID & " where ClassID=" & NextID end if dim mrs,MaxRootID set mrs=conn.execute("select max(rootid) From ArticleClass") MaxRootID=mrs(0)+1 '先将当前栏目移至最后，包括子栏目 conn.execute("update ArticleClass set RootID=" & MaxRootID & " where RootID=" & cRootID) '然后将位于当前栏目以下的栏目的RootID依次减一，范围为要下降的数字 sqlOrder="select * From ArticleClass where ParentID=0 and RootID>" & cRootID & " order by RootID" set rsOrder=server.CreateObject("adodb.recordset") rsOrder.open sqlOrder,conn,1,3 if rsOrder.bof and rsOrder.eof then exit sub '如果当前栏目已经在最下面，则无需移动 end if i=1 do while not rsOrder.eof tRootID=rsOrder("RootID") '得到要提升位置的RootID，包括子栏目 conn.execute("update ArticleClass set RootID=RootID-1 where RootID=" & tRootID) i=i+1 if i>MoveNum then rsOrder("NextID")=ClassID rsOrder.update conn.execute("update ArticleClass set PrevID=" & rsOrder("ClassID") & " where ClassID=" & ClassID) exit do end if rsOrder.movenext loop rsOrder.movenext if rsOrder.eof then conn.execute("update ArticleClass set NextID=0 where ClassID=" & ClassID) else rsOrder("PrevID")=ClassID rsOrder.update conn.execute("update ArticleClass set NextID=" & rsOrder("ClassID") & " where ClassID=" & ClassID) end if rsOrder.close set rsOrder=nothing '然后再将当前栏目从最后移到相应位置，包括子栏目 conn.execute("update ArticleClass set RootID=" & tRootID & " where RootID=" & MaxRootID) call CloseConn() response.Redirect "Admin_Class_Article.asp?Action=Order" end sub sub UpOrderN() dim sqlOrder,rsOrder,MoveNum,ClassID,i dim ParentID,OrderID,ParentPath,Child,PrevID,NextID ClassID=Trim(request("ClassID")) MoveNum=trim(request("MoveNum")) if ClassID="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " else ClassID=CLng(ClassID) end if if MoveNum="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " else MoveNum=Cint(MoveNum) if MoveNum=0 then FoundErr=True ErrMsg=ErrMsg & "
  • 请选择要提升的数字！
    • " end if end if if FoundErr=True then exit sub end if dim sql,rs,oldorders,ii,trs,tOrderID '要移动的栏目信息 set rs=conn.execute("select ParentID,OrderID,ParentPath,child,PrevID,NextID From ArticleClass where ClassID="&ClassID) ParentID=rs(0) OrderID=rs(1) ParentPath=rs(2) & "," & ClassID child=rs(3) PrevID=rs(4) NextID=rs(5) rs.close set rs=nothing if child>0 then set rs=conn.execute("select count(*) From ArticleClass where ParentPath like '%"&ParentPath&"%'") oldorders=rs(0) rs.close set rs=nothing else oldorders=0 end if '先修改上一栏目的NextID和下一栏目的PrevID if PrevID>0 then conn.execute "update ArticleClass set NextID=" & NextID & " where ClassID=" & PrevID end if if NextID>0 then conn.execute "update ArticleClass set PrevID=" & PrevID & " where ClassID=" & NextID end if '和该栏目同级且排序在其之上的栏目------更新其排序，范围为要提升的数字 sql="select ClassID,OrderID,child,ParentPath,PrevID,NextID From ArticleClass where ParentID="&ParentID&" and OrderID<"&OrderID&" order by OrderID desc" set rs=server.CreateObject("adodb.recordset") rs.open sql,conn,1,3 i=1 do while not rs.eof tOrderID=rs(1) conn.execute("update ArticleClass set OrderID="&tOrderID+oldorders+i&" where ClassID="&rs(0)) if rs(2)>0 then ii=i+1 set trs=conn.execute("select ClassID,OrderID From ArticleClass where ParentPath like '%"&rs(3)&","&rs(0)&"%' order by OrderID") if not (trs.eof and trs.bof) then do while not trs.eof conn.execute("update ArticleClass set OrderID="&tOrderID+oldorders+ii&" where ClassID="&trs(0)) ii=ii+1 trs.movenext loop end if trs.close set trs=nothing end if i=i+1 if i>MoveNum then rs(4)=ClassID rs.update conn.execute("update ArticleClass set NextID=" & rs(0) & " where ClassID=" & ClassID) exit do end if rs.movenext loop rs.movenext if rs.eof then conn.execute("update ArticleClass set PrevID=0 where ClassID=" & ClassID) else rs(5)=ClassID rs.update conn.execute("update ArticleClass set PrevID=" & rs(0) & " where ClassID=" & ClassID) end if rs.close set rs=nothing '更新所要排序的栏目的序号 conn.execute("update ArticleClass set OrderID="&tOrderID&" where ClassID="&ClassID) '如果有下属栏目，则更新其下属栏目排序 if child>0 then i=1 set rs=conn.execute("select ClassID From ArticleClass where ParentPath like '%"&ParentPath&"%' order by OrderID") do while not rs.eof conn.execute("update ArticleClass set OrderID="&tOrderID+i&" where ClassID="&rs(0)) i=i+1 rs.movenext loop rs.close set rs=nothing end if call CloseConn() response.Redirect "Admin_Class_Article.asp?Action=OrderN" end sub sub DownOrderN() dim sqlOrder,rsOrder,MoveNum,ClassID,i dim ParentID,OrderID,ParentPath,Child,PrevID,NextID ClassID=Trim(request("ClassID")) MoveNum=trim(request("MoveNum")) if ClassID="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " exit sub else ClassID=Cint(ClassID) end if if MoveNum="" then FoundErr=true ErrMsg=ErrMsg & "
  • 错误参数！
    • " exit sub else MoveNum=Cint(MoveNum) if MoveNum=0 then FoundErr=True ErrMsg=ErrMsg & "
  • 请选择要下降的数字！
    • " exit sub end if end if dim sql,rs,oldorders,ii,trs,tOrderID '要移动的栏目信息 set rs=conn.execute("select ParentID,OrderID,ParentPath,child,PrevID,NextID From ArticleClass where ClassID="&ClassID) ParentID=rs(0) OrderID=rs(1) ParentPath=rs(2) & "," & ClassID child=rs(3) PrevID=rs(4) NextID=rs(5) rs.close set rs=nothing '先修改上一栏目的NextID和下一栏目的PrevID if PrevID>0 then conn.execute "update ArticleClass set NextID=" & NextID & " where ClassID=" & PrevID end if if NextID>0 then conn.execute "update ArticleClass set PrevID=" & PrevID & " where ClassID=" & NextID end if '和该栏目同级且排序在其之下的栏目------更新其排序，范围为要下降的数字 sql="select ClassID,OrderID,child,ParentPath,PrevID,NextID From ArticleClass where ParentID="&ParentID&" and OrderID>"&OrderID&" order by OrderID" set rs=server.CreateObject("adodb.recordset") rs.open sql,conn,1,3 i=0 '同级栏目 ii=0 '同级栏目和子栏目 do while not rs.eof conn.execute("update ArticleClass set OrderID="&OrderID+ii&" where ClassID="&rs(0)) if rs(2)>0 then set trs=conn.execute("select ClassID,OrderID From ArticleClass where ParentPath like '%"&rs(3)&","&rs(0)&"%' order by OrderID") if not (trs.eof and trs.bof) then do while not trs.eof ii=ii+1 conn.execute("update ArticleClass set OrderID="&OrderID+ii&" where ClassID="&trs(0)) trs.movenext loop end if trs.close set trs=nothing end if ii=ii+1 i=i+1 if i>=MoveNum then rs(5)=ClassID rs.update conn.execute("update ArticleClass set PrevID=" & rs(0) & " where ClassID=" & ClassID) exit do end if rs.movenext loop rs.movenext if rs.eof then conn.execute("update ArticleClass set NextID=0 where ClassID=" & ClassID) else rs(4)=ClassID rs.update conn.execute("update ArticleClass set NextID=" & rs(0) & " where ClassID=" & ClassID) end if rs.close set rs=nothing '更新所要排序的栏目的序号 conn.execute("update ArticleClass set OrderID="&OrderID+ii&" where ClassID="&ClassID) '如果有下属栏目，则更新其下属栏目排序 if child>0 then i=1 set rs=conn.execute("select ClassID From ArticleClass where ParentPath like '%"&ParentPath&"%' order by OrderID") do while not rs.eof conn.execute("update ArticleClass set OrderID="&OrderID+ii+i&" where ClassID="&rs(0)) i=i+1 rs.movenext loop rs.close set rs=nothing end if call CloseConn() response.Redirect "Admin_Class_Article.asp?Action=OrderN" end sub sub SaveReset() dim i,sql,rs,SuccessMsg,iCount,PrevID,NextID sql="select ClassID From ArticleClass order by RootID,OrderID" set rs=server.CreateObject("adodb.recordset") rs.open sql,conn,1,1 iCount=rs.recordcount i=1 PrevID=0 do while not rs.eof rs.movenext if rs.eof then NextID=0 else NextID=rs(0) end if rs.moveprevious conn.execute("update ArticleClass set RootID=" & i & ",OrderID=0,ParentID=0,Child=0,ParentPath='0',Depth=0,PrevID=" & PrevID & ",NextID=" & NextID & " where ClassID=" & rs(0)) PrevID=rs(0) i=i+1 rs.movenext loop rs.close set rs=nothing SuccessMsg="复位成功！请返回栏目管理首页做栏目的归属设置。" call WriteSuccessMsg(SuccessMsg) end sub sub SaveUnite() dim ClassID,TargetClassID,ParentPath,iParentPath,Depth,iParentID,Child,PrevID,NextID dim rs,trs,i,SuccessMsg ClassID=trim(request("ClassID")) TargetClassID=trim(request("TargetClassID")) if ClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定要合并的栏目！
    • " else ClassID=CLng(ClassID) end if if TargetClassID="" then FoundErr=True ErrMsg=ErrMsg & "
  • 请指定目标栏目！
    • " else TargetClassID=CLng(TargetClassID) end if if ClassID=TargetClassID then FoundErr=True ErrMsg=ErrMsg & "
  • 请不要在相同栏目内进行操作
    • " end if if FoundErr=True then exit sub end if '判断目标栏目是否有子栏目，如果有，则报错。 set rs=conn.execute("select Child from ArticleClass where ClassID=" & TargetClassID) if rs.bof and rs.eof then FoundErr=True ErrMsg=ErrMsg & "
  • 目标栏目不存在，可能已经被删除！
    • " else if rs(0)>0 then FoundErr=True ErrMsg=ErrMsg & "
  • 目标栏目中含有子栏目，不能合并！
    • " end if end if if FoundErr=True then exit sub end if '得到当前栏目信息 set rs=conn.execute("select ClassID,ParentID,ParentPath,PrevID,NextID,Depth from ArticleClass where ClassID="&ClassID) iParentID=rs(1) Depth=rs(5) if iParentID=0 then ParentPath=rs(0) else ParentPath=rs(2) & "," & rs(0) end if iParentPath=rs(0) PrevID=rs(3) NextID=rs(4) '判断是否是合并到其下属栏目中 set rs=conn.execute("select ClassID from ArticleClass where ClassID="&TargetClassID&" and ParentPath like '"&ParentPath&"%'") if not (rs.eof and rs.bof) then FoundErr=true ErrMsg=ErrMsg & "
  • 不能将一个栏目合并到其下属子栏目中
    • " exit sub end if '得到当前栏目的下属栏目ID set rs=conn.execute("select ClassID from ArticleClass where ParentPath like '"&ParentPath&"%'") i=0 if not (rs.eof and rs.bof) then do while not rs.eof iParentPath=iParentPath & "," & rs(0) i=i+1 rs.movenext loop end if if i>0 then ParentPath=iParentPath else ParentPath=ClassID end if '先修改上一栏目的NextID和下一栏目的PrevID if PrevID>0 then conn.execute "update ArticleClass set NextID=" & NextID & " where ClassID=" & PrevID end if if NextID>0 then conn.execute "update ArticleClass set PrevID=" & PrevID & " where ClassID=" & NextID end if '更新文章及评论所属栏目 conn.execute("update Article set ClassID="&TargetClassID&" where ClassID in ("&ParentPath&")") conn.execute("update ArticleComment set ClassID="&TargetClassID&" where ClassID in ("&ParentPath&")") '删除被合并栏目及其下属栏目 conn.execute("delete from ArticleClass where ClassID in ("&ParentPath&")") '更新其原来所属栏目的子栏目数，排序相当于剪枝而不需考虑 if Depth>0 then conn.execute("update ArticleClass set Child=Child-1 where ClassID="&iParentID) end if SuccessMsg="栏目合并成功！已经将被合并栏目及其下属子栏目的所有数据转入目标栏目中。

    同时删除了被合并的栏目及其子栏目。" call WriteSuccessMsg(SuccessMsg) set rs=nothing set trs=nothing end sub %>