admin_userclass.asp

本息统基于中国网站技术人员最熟悉WindowsNT环境和Asp语言

	loop
	rsOrder.movenext
	if rsOrder.eof then
		conn.execute("update oblog_userclass set NextID=0 where id=" & id)
	else
		rsOrder("PrevID")=id
		rsOrder.update
		conn.execute("update oblog_userclass set NextID=" & rsOrder("id") & " where id=" & id)
	end if	
	rsOrder.close
	set rsOrder=nothing
	
	'然后再将当前分类从最后移到相应位置，包括子分类
	conn.execute("update oblog_userclass set RootID=" & tRootID & " where RootID=" & MaxRootID)
	'call CloseConn()
	response.Redirect "admin_userclass.asp?Action=Order"
end sub

sub UpOrderN()
	dim sqlOrder,rsOrder,MoveNum,id,i
	dim ParentID,OrderID,ParentPath,Child,PrevID,NextID
	id=Trim(request("id"))
	MoveNum=trim(request("MoveNum"))
	if id="" then
		FoundErr=true
		ErrMsg=ErrMsg & "<br><li>错误参数！</li>"
	else
		id=CLng(id)
	end if
	if MoveNum="" then
		FoundErr=true
		ErrMsg=ErrMsg & "<br><li>错误参数！</li>"
	else
		MoveNum=Cint(MoveNum)
		if MoveNum=0 then
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>请选择要提升的数字！</li>"
		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 oblog_userclass where id="&id)
	ParentID=rs(0)
	OrderID=rs(1)
	ParentPath=rs(2) & "," & id
	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 oblog_userclass 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 oblog_userclass set NextID=" & NextID & " where id=" & PrevID
	end if
	if NextID>0 then
		conn.execute "update oblog_userclass set PrevID=" & PrevID & " where id=" & NextID
	end if
	
	'和该分类同级且排序在其之上的分类------更新其排序，范围为要提升的数字
	sql="select id,OrderID,child,ParentPath,PrevID,NextID From oblog_userclass 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)
		
		if rs(2)>0 then
			ii=i+1
			set trs=conn.execute("select id,OrderID From oblog_userclass 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 oblog_userclass set OrderID="&tOrderID+oldorders+ii&" where id="&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)=id
			rs.update
			conn.execute("update oblog_userclass set NextID=" & rs(0) & " where id=" & id)
			conn.execute("update oblog_userclass set OrderID="&tOrderID+oldorders+i-1&" where id="&rs(0))		
			exit do
		end if
		conn.execute("update oblog_userclass set OrderID="&tOrderID+oldorders+i-1&" where id="&rs(0))
		rs.movenext
	loop
	if not rs.eof then
	rs.movenext
	end if
	if rs.eof then
		conn.execute("update oblog_userclass set PrevID=0 where id=" & id)
	else
		rs(5)=id
		rs.update
		conn.execute("update oblog_userclass set PrevID=" & rs(0) & " where id=" & id)
	end if	
	rs.close
	set rs=nothing
	
	'更新所要排序的分类的序号
	conn.execute("update oblog_userclass set OrderID="&tOrderID&" where id="&id)
	'如果有下属分类，则更新其下属分类排序
	if child>0 then
		i=1
		set rs=conn.execute("select id From oblog_userclass where ParentPath like '%"&ParentPath&"%' order by OrderID")
		do while not rs.eof
			conn.execute("update oblog_userclass set OrderID="&tOrderID+i&" where id="&rs(0))
			i=i+1
			rs.movenext
		loop
		rs.close
		set rs=nothing
	end if
	'call CloseConn()
	response.Redirect "admin_userclass.asp?Action=OrderN"
end sub

sub DownOrderN()
	dim sqlOrder,rsOrder,MoveNum,id,i
	dim ParentID,OrderID,ParentPath,Child,PrevID,NextID
	id=Trim(request("id"))
	MoveNum=trim(request("MoveNum"))
	if id="" then
		FoundErr=true
		ErrMsg=ErrMsg & "<br><li>错误参数！</li>"
		exit sub
	else
		id=Cint(id)
	end if
	if MoveNum="" then
		FoundErr=true
		ErrMsg=ErrMsg & "<br><li>错误参数！</li>"
		exit sub
	else
		MoveNum=Cint(MoveNum)
		if MoveNum=0 then
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>请选择要下降的数字！</li>"
			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 oblog_userclass where id="&id)
	ParentID=rs(0)
	OrderID=rs(1)
	ParentPath=rs(2) & "," & id
	child=rs(3)
	PrevID=rs(4)
	NextID=rs(5)
	rs.close
	set rs=nothing

	'先修改上一分类的NextID和下一分类的PrevID
	if PrevID>0 then
		conn.execute "update oblog_userclass set NextID=" & NextID & " where id=" & PrevID
	end if
	if NextID>0 then
		conn.execute "update oblog_userclass set PrevID=" & PrevID & " where id=" & NextID
	end if
	
	'和该分类同级且排序在其之下的分类------更新其排序，范围为要下降的数字
	sql="select id,OrderID,child,ParentPath,PrevID,NextID From oblog_userclass 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 oblog_userclass set OrderID="&OrderID+ii&" where id="&rs(0))
		if rs(2)>0 then
			set trs=conn.execute("select id,OrderID From oblog_userclass 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 oblog_userclass set OrderID="&OrderID+ii&" where id="&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)=id
			rs.update
			conn.execute("update oblog_userclass set PrevID=" & rs(0) & " where id=" & id)
			conn.execute("update oblog_userclass set OrderID="&OrderID+ii-1&" where id="&rs(0))		
			exit do
		end if
		conn.execute("update oblog_userclass set OrderID="&OrderID+ii-1&" where id="&rs(0))
		rs.movenext
	loop
	rs.movenext
	if rs.eof then
		conn.execute("update oblog_userclass set NextID=0 where id=" & id)
	else
		rs(4)=id
		rs.update
		conn.execute("update oblog_userclass set NextID=" & rs(0) & " where id=" & id)
	end if	
	rs.close
	set rs=nothing
	
	'更新所要排序的分类的序号
	conn.execute("update oblog_userclass set OrderID="&OrderID+ii&" where id="&id)
	'如果有下属分类，则更新其下属分类排序
	if child>0 then
		i=1
		set rs=conn.execute("select id From oblog_userclass where ParentPath like '%"&ParentPath&"%' order by OrderID")
		do while not rs.eof
			conn.execute("update oblog_userclass set OrderID="&OrderID+ii+i&" where id="&rs(0))
			i=i+1
			rs.movenext
		loop
		rs.close
		set rs=nothing
	end if
	'call CloseConn()
	response.Redirect "admin_userclass.asp?Action=OrderN"
end sub

sub SaveReset()
	dim i,sql,rs,SuccessMsg,iCount,PrevID,NextID
	sql="select id From oblog_userclass 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 oblog_userclass set RootID=" & i & ",OrderID=0,ParentID=0,Child=0,ParentPath='0',Depth=0,PrevID=" & PrevID & ",NextID=" & NextID & " where id=" & rs(0))
		PrevID=rs(0)
		i=i+1
		rs.movenext
	loop
	rs.close
	set rs=nothing	
	
	response.Write "复位成功！请返回<a href='admin_userclass.asp'>分类管理首页</a>做分类的归属设置。"
end sub

sub SaveUnite()
	dim id,Targetid,ParentPath,iParentPath,Depth,iParentID,Child,PrevID,NextID
	dim rs,trs,i
	id=trim(request("id"))
	Targetid=trim(request("Targetid"))
	if id="" then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请指定要合并的分类！</li>"
	else
		id=CLng(id)
	end if
	if Targetid="" then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请指定目标分类！</li>"
	else
		Targetid=CLng(Targetid)
	end if
	if id=Targetid then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请不要在相同分类内进行操作</li>"
	end if
	if FoundErr=True then
		exit sub
	end if
	'判断目标分类是否有子分类，如果有，则报错。
	set rs=conn.execute("select Child From oblog_userclass where id=" & Targetid)
	if rs.bof and rs.eof then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>目标分类不存在，可能已经被删除！</li>"
	else
		if rs(0)>0 then
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>目标分类中含有子分类，不能合并！</li>"
		end if
	end if
	if FoundErr=True then
		exit sub
	end if

	'得到当前分类信息
	set rs=conn.execute("select id,ParentID,ParentPath,PrevID,NextID,Depth From oblog_userclass where id="&id)
	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 id From oblog_userclass where id="&Targetid&" and ParentPath like '"&ParentPath&"%'")
	if not (rs.eof and rs.bof) then
		response.Write "<br><li>不能将一个分类合并到其下属子分类中</li>"
		exit sub
	end if
	
	'得到当前分类的下属分类ID
	set rs=conn.execute("select id From oblog_userclass 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=id
	end if
	
	'先修改上一分类的NextID和下一分类的PrevID
	if PrevID>0 then
		conn.execute "update oblog_userclass set NextID=" & NextID & " where id=" & PrevID
	end if
	if NextID>0 then
		conn.execute "update oblog_userclass set PrevID=" & PrevID & " where id=" & NextID
	end if
	
	'更新user所属分类
	conn.execute("update [oblog_user] set user_classid="&Targetid&" where user_classid in ("&ParentPath&")")
	
	'删除被合并分类及其下属分类
	conn.execute("delete From oblog_userclass where id in ("&ParentPath&")")
	
	'更新其原来所属分类的子分类数，排序相当于剪枝而不需考虑
	if Depth>0 then
		conn.execute("update oblog_userclass set Child=Child-1 where id="&iParentID)
	end if
	
	response.Write "分类合并成功！已经将被合并分类及其下属子分类的所有数据转入目标分类中。<br><br>同时删除了被合并的分类及其子分类。"
	set rs=nothing
	set trs=nothing
end sub

sub Admin_ShowClass_Option(ShowType,CurrentID)
	if ShowType=0 then
	    response.write "<option value='0'"
		if CurrentID=0 then response.write " selected"
		response.write ">无（作为一级栏目）</option>"
	end if
	dim rsClass,sqlClass,strTemp,tmpDepth,i
	dim arrShowLine(20)
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	sqlClass="Select * From oblog_userclass order by RootID,OrderID"
	set rsClass=conn.execute(sqlClass)
	if rsClass.bof and rsClass.eof then 
		response.write "<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
				strTemp="<option value='" & rsClass("id") & "'"
			if CurrentID>0 and rsClass("id")=CurrentID then
				 strTemp=strTemp & " selected"
			end if
			strTemp=strTemp & ">"
			
			if tmpDepth>0 then
				for i=1 to tmpDepth
					strTemp=strTemp & "&nbsp;&nbsp;"
					if i=tmpDepth then
						if rsClass("NextID")>0 then
							strTemp=strTemp & "├&nbsp;"
						else
							strTemp=strTemp & "└&nbsp;"
						end if
					else
						if arrShowLine(i)=True then
							strTemp=strTemp & "│"
						else
							strTemp=strTemp & "&nbsp;"
						end if
					end if
				next
			end if
			strTemp=strTemp & rsClass("classname")
			strTemp=strTemp & "</option>"
			response.write strTemp
			rsClass.movenext
		loop
	end if
	rsClass.close
	set rsClass=nothing
end sub

%>