ASP无限级分类代码示例方面的知识_【华易动力-十年网站设计公司】

ASP无限级分类代码示例方面的知识

更新时间：2012/10/31 点击：1226次

<!--#include file="../include/conn.asp"--> 
<% 
Dim Action,ParentID,ErrMsg,FoundErr,strTemp 
ParentID=trim(request("ParentID")) 
Action=trim(Request("Action")) 
 
if ParentID="" then 
ParentID=0 
else 
ParentID=CLng(ParentID) 
end if 
%>

<html> 
<head> 
<meta http-equiv="Content-Type" content="text/html; charset=gb2312"> 
<title>分类管理</title> 
<link href="style.css" rel="stylesheet" type="text/css"> 
</head> 
 
<body> 
<table width="100%" border="0" align="center" cellpadding="2" cellspacing="1" class="border"> 
<tr class="topbg"> 
<td height="22" colspan="2" align="center"><strong>信 息 分 类 管 理</strong></td> 
</tr> 
<tr class="tdbg"> 
<td width="100" height="30" ><strong>分类管理导航：</strong></td> 
<td> <a href="?Action=Add">添加分类</a> | <a href="?">管理分类</a></td> 
</tr> 
</table> 
<% 
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="Del" then 
call DeleteClass() 
else 
call main() 
end if 
conn.close 
set conn=nothing 
 
if FoundErr=True then 
call WriteErrMsg() 
end if 
 
sub main() 
dim arrShowLine(10) 
for i=0 to ubound(arrShowLine) 
arrShowLine(i)=False 
next 
dim sqlClass,rsClass,i,iDepth 
sqlClass="select * From zl_class order by RootID,OrderID" 
 
set rsClass=server.CreateObject("adodb.recordset") 
rsClass.open sqlClass,conn,1,1 
%> 
<table width="100%" border="0" cellpadding="2" cellspacing="1" class="border"> 
<tr align="center" class="title"> 
<td width="50%" height="22"><strong>信息分类名称</strong></td> 
<td><strong>操作选项</strong></td> 
</tr> 
<% 
If Not rsClass.Eof Then 
do while not rsClass.eof 
%> 
<tr class="tdbg"> 
<td> 
<% 
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 "<img src='images/tree/tree_line1.gif' width='17' height='16' valign='abvmiddle'>" 
else 
response.write "<img src='images/tree/tree_line2.gif' width='17' height='16' valign='abvmiddle'>" 
end if 
else 
if arrShowLine(i)=True then 
response.write "<img src='images/tree/tree_line3.gif' width='17' height='16' valign='abvmiddle'>" 
else 
response.write "<img src='images/tree/tree_line4.gif' width='17' height='16' valign='abvmiddle'>" 
end if 
end if 
next 
end if 
if rsClass("Child")>0 then 
response.write "<img src='images/tree/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>" 
else 
response.write "<img src='images/tree/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>" 
end if 
if rsClass("Depth")=0 then 
response.write "<b>" 
end if 
response.write "<a href='?Action=Modify&ClassID=" & rsClass("ClassID") & "' title='" & rsClass("ClassName") & "'>" & rsClass("ClassName") & "</a>" 
if rsClass("Child")>0 then 
response.write "（" & rsClass("Child") & "）" 
end if 
%> 
</td> 
<td align="center"> 
<a href="?Action=Add&ParentID=<%=rsClass("ClassID")%>">添加子分类</a> 
| <a href="?Action=Modify&ClassID=<%=rsClass("ClassID")%>">修改设置</a> | <a href="?Action=Del&ClassID=<%=rsClass("ClassID")%>" onClick="<%if rsClass("Child")>0 then%>return ConfirmDel1();<%else%>return ConfirmDel2();<%end if%>">删除分类</a> </td> 
</tr> 
<% 
rsClass.movenext 
loop 
Else 
Response.Write("<tr><td class=""tdbg"" height=""22"" colspan=""2"" align=""center"">请先添加分类！</td></tr>") 
End If 
rsClass.close 
set rsClass=nothing 
%> 
</table> 
<script language="JavaScript" type="text/JavaScript"> 
function ConfirmDel1() 
{ 
alert("此分类下还有子分类，必须先删除下属子分类后才能删除此分类！"); 
return false; 
} 
 
function ConfirmDel2() 
{ 
if(confirm("删除分类将同时删除此分类中的所有信息，并且不能恢复！确定要删除此分类吗？")) 
return true; 
else 
return false; 
 
} 
</script> 
<% 
end sub 
 
sub AddClass() 
%> 
<table width="100%" border="0" cellpadding="2" cellspacing="1" class="border"> 
<form name="form1" method="post" action="?" onSubmit="return check()"> 
<tr align="center" class="title"> 
<td height="22" colspan="2"><strong>添加分类</strong></td> 
</tr> 
<tr class="tdbg"> 
<td width="40%" align="right"><strong>所属分类</strong>：<br></td> 
<td> 
<select name="ParentID"> 
<%call ShowClass_Option(0,ParentID)%> 
</select> 
</td> 
</tr> 
<tr class="tdbg"> 
<td height="22" align="right"><strong>分类名称</strong>：</td> 
<td> 
<input name="ClassName" type="text" size="37" maxlength="20"></td> 
</tr> 
 
<tr class="tdbg"> 
<td colspan="2" align="center"><br> 
<input name="Action" type="hidden" id="Action" value="SaveAdd"> <input name="Add" type="submit" class="button" id="Add" value="添加分类"> 
    <input name="Cancel" type="button" class="button" id="Cancel" onClick="window.location.href='?'" value="取 消"> 
<br> 
<br></td> 
</tr> 
</form> 
</table> 
<script language="JavaScript" type="text/JavaScript"> 
function check() 
{ 
if (document.form1.ClassName.value=="") 
{ 
alert("分类名称不能为空！"); 
document.form1.ClassName.focus(); 
return false; 
} 
} 
</script> 
<% 
end sub 
 
sub Modify() 
dim ClassID,sql,rsClass,i 
ClassID=trim(request("ClassID")) 
if ClassID="" then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>参数不足！</li>" 
exit sub 
else 
ClassID=CLng(ClassID) 
end if 
 
sql="select * From zl_class where ClassID=" & ClassID 
set rsClass=server.CreateObject ("Adodb.recordset") 
rsClass.open sql,conn,1,3 
if rsClass.bof and rsClass.eof then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>找不到指定的分类！</li>" 
else 
%> 
<table width="100%" border="0" cellpadding="2" cellspacing="1" class="border"> 
<form name="form1" method="post" action="?" onSubmit="return check()"> 
<tr class="title"> 
<td height="22" colspan="2" align="center"><strong>修改分类</strong></td> 
</tr> 
<tr class="tdbg"> 
<td width="40%" align="right"><strong>所属分类</strong>：<br></td> 
<td> 
<% 
if rsClass("ParentID")<=0 then 
response.write "无（作为一级分类）" 
else 
dim rsParentClass,sqlParentClass 
sqlParentClass="Select * From zl_class 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") & "<br>" 
rsParentClass.movenext 
loop 
rsParentClass.close 
set rsParentClass=nothing 
end if 
%> </td> 
</tr> 
<tr class="tdbg"> 
<td align="right"><strong>分类名称</strong>：</td> 
<td><input name="ClassName" type="text" value="<%=rsClass("ClassName")%>" size="37" maxlength="20"> 
<input name="ClassID" type="hidden" id="ClassID" value="<%=rsClass("ClassID")%>"></td> 
</tr> 
 
<tr class="tdbg"> 
<td colspan="2" align="center"><br> 
<input name="Action" type="hidden" id="Action" value="SaveModify"> <input name="Submit" type="submit" class="button" id="Submit" value="保存修改结果"> 
    <input name="Cancel" type="button" class="button" id="Cancel" onClick="window.location.href='?'" value="取 消"> 
<br> 
<br></td> 
</tr> 
</form> 
</table> 
<script language="JavaScript" type="text/JavaScript"> 
function check() 
{ 
if (document.form1.ClassName.value=="") 
{ 
alert("分类名称不能为空！"); 
document.form1.ClassName.focus(); 
return false; 
} 
} 
</script> 
<% 
end if 
rsClass.close 
set rsClass=nothing 
end sub 
%> 
</body> 
</html> 
<% 
sub SaveAdd() 
dim ClassID,ClassName,OnElite,OnTop,ClassPicUrl,LinkUrl,PrevOrderID 
dim sql,rs,trs 
dim RootID,ParentDepth,ParentPath,ParentStr,ParentName,MaxClassID,MaxRootID 
dim PrevID,NextID,Child 
FoundErr=False 
ClassName=trim(request("ClassName")) 
if ClassName="" then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>分类名称不能为空！</li>" 
end if 
if FoundErr=True then 
exit sub 
end if 
 
set rs = conn.execute("select Max(ClassID) From zl_class") 
MaxClassID=rs(0) 
if isnull(MaxClassID) then 
MaxClassID=0 
end if 
rs.close 
ClassID=MaxClassID+1 
set rs=conn.execute("select max(RootID) From zl_class") 
MaxRootID=rs(0) 
if isnull(MaxRootID) then 
MaxRootID=0 
end if 
rs.close 
RootID=MaxRootID+1 
 
if ParentID>0 then 
sql="select * From zl_class where ClassID=" & ParentID & "" 
rs.open sql,conn,1,1 
if rs.bof and rs.eof then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>所属分类已经被删除！</li>" 
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") 
ParentPathParentPath=ParentPath & "," & ParentID '得到此分类的父级分类路径 
PrevOrderID=rs("OrderID") 
if Child>0 then 
dim rsPrevOrderID 
'得到与本分类同级的最后一个分类的OrderID 
set rsPrevOrderID=conn.execute("select Max(OrderID) From zl_class where ParentID=" & ParentID) 
PrevOrderID=rsPrevOrderID(0) 
set trs=conn.execute("select ClassID From zl_class where ParentID=" & ParentID & " and OrderID=" & PrevOrderID) 
PrevID=trs(0) 
 
'得到同一父分类但比本分类级数大的子分类的最大OrderID，如果比前一个值大，则改用这个值。 
set rsPrevOrderID=conn.execute("select Max(OrderID) From zl_class 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 zl_class 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 zl_class 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 
ErrMsgErrMsg=ErrMsg & "<br><li>已经存在一级分类：" & ClassName & "</li>" 
else 
ErrMsgErrMsg=ErrMsg & "<br><li>“" & ParentName & "”中已经存在子分类“" & ClassName & "”！</li>" 
end if 
rs.close 
set rs=nothing 
exit sub 
end if 
rs.close 
 
sql="Select top 1 * From zl_class" 
rs.open sql,conn,1,3 
rs.addnew 
rs("ClassID")=ClassID 
rs("ClassName")=ClassName 
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("PrevID")=PrevID 
rs("NextID")=0 
rs.update 
rs.Close 
set rs=Nothing 
 
'更新与本分类同一父分类的上一个分类的“NextID”字段值 
if PrevID>0 then 
conn.execute("update zl_class set NextID=" & ClassID & " where ClassID=" & PrevID) 
end if 
 
if ParentID>0 then 
'更新其父类的子分类数 
conn.execute("update zl_class set ChildChild=Child+1 where ClassID="&ParentID) 
 
'更新该分类排序以及大于本需要和同在本分类下的分类排序序号 
conn.execute("update zl_class set OrderIDOrderID=OrderID+1 where RootID=" & rootid & " and OrderID>" & PrevOrderID) 
conn.execute("update zl_class set OrderID=" & PrevOrderID & "+1 where ClassID=" & ClassID) 
end if 
Response.Redirect "?" 
end sub 
 
sub SaveModify() 
dim ClassName,OnElite,OnTop,ClassPicUrl,LinkUrl 
dim trs,rs 
dim ClassID,sql,rsClass,i 
FoundErr=False 
 
ClassID=trim(request("ClassID")) 
if ClassID="" then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>参数不足！</li>" 
else 
ClassID=CLng(ClassID) 
end if 
ClassName=trim(request("ClassName")) 
OnElite=trim(request("OnElite")) 
OnTop=trim(request("OnTop")) 
ClassPicUrl=trim(request("ClassPicUrl")) 
LinkUrl=trim(request("LinkUrl")) 
if ClassName="" then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>分类名称不能为空！</li>" 
end if 
 
if FoundErr=True then 
exit sub 
end if 
 
sql="select * From zl_class where ClassID=" & ClassID 
set rsClass=server.CreateObject ("Adodb.recordset") 
rsClass.open sql,conn,1,3 
if rsClass.bof and rsClass.eof then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>找不到指定的分类！</li>" 
rsClass.close 
set rsClass=nothing 
exit sub 
end if 
if rsClass("Child")>0 and LinkUrl<>"" then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>本分类有子分类，所以不能设为外部链接地址。</li>" 
end if 
if OnElite="Yes" then 
OnElite=True 
else 
OnElite=False 
end if 
if OnTop="Yes" then 
OnTop=True 
else 
OnTop=False 
end if 
if FoundErr=True then 
rsClass.close 
set rsClass=nothing 
exit sub 
end if 
rsClass("ClassName")=ClassName 
rsClass.update 
rsClass.close 
set rsClass=nothing 
Response.Redirect "?" 
end sub 
 
 
sub DeleteClass() 
dim sql,rs,PrevID,NextID,ClassID 
FoundErr=False 
 
ClassID=trim(Request("ClassID")) 
if ClassID="" then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>参数不足！</li>" 
exit sub 
else 
ClassID=CLng(ClassID) 
end if 
 
sql="select * From zl_class where ClassID=" & ClassID 
set rs=server.CreateObject ("Adodb.recordset") 
rs.open sql,conn,1,3 
if rs.bof and rs.eof then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>分类不存在，或者已经被删除</li>" 
else 
if rs("Child")>0 then 
FoundErr=True 
ErrMsgErrMsg=ErrMsg & "<br><li>该分类含有子分类，请删除其子分类后再进行删除本分类的操作</li>" 
end if 
end if 
if FoundErr=True then 
rs.close 
set rs=nothing 
exit sub 
end if 
PrevID=rs("PrevID") 
NextID=rs("NextID") 
if rs("Depth")>0 then 
conn.execute("update zl_class set ChildChild=Child-1 where ClassID=" & rs("ParentID")) 
end if 
rs.delete 
rs.update 
rs.close 
set rs=nothing 
 
'修改上一分类的NextID和下一分类的PrevID 
if PrevID>0 then 
conn.execute "update zl_class set NextID=" & NextID & " where ClassID=" & PrevID 
end if 
if NextID>0 then 
conn.execute "update zl_class set PrevID=" & PrevID & " where ClassID=" & NextID 
end if 
Response.Redirect "?" 
end sub 
 
sub 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 zl_class 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 
if ShowType=1 then 
strTemp="<option value='" & rsClass("ClassID") & "'" 
elseif ShowType=2 then 
strTemp="<option value='" & rsClass("ClassID") & "'" 
elseif ShowType=3 then 
if rsClass("Child")>0 then 
strTemp="<option value=''" 
else 
strTemp="<option value='" & rsClass("ClassID") & "'" 
end if 
elseif ShowType=4 then 
if rsClass("Child")>0 then 
strTemp="<option value=''" 
else 
strTemp="<option value='" & rsClass("ClassID") & "'" 
end if 
else 
strTemp="<option value='" & rsClass("ClassID") & "'" 
end if 
if CurrentID>0 and rsClass("ClassID")=CurrentID then 
strTempstrTemp=strTemp & " selected" 
end if 
strTempstrTemp=strTemp & ">" 
 
if tmpDepth>0 then 
for i=1 to tmpDepth 
strTempstrTemp=strTemp & "   " 
if i=tmpDepth then 
if rsClass("NextID")>0 then 
strTempstrTemp=strTemp & "├ " 
else 
strTempstrTemp=strTemp & "└ " 
end if 
else 
if arrShowLine(i)=True then 
strTempstrTemp=strTemp & "│" 
else 
strTempstrTemp=strTemp & " " 
end if 
end if 
next 
end if 
strTempstrTemp=strTemp & rsClass("ClassName") 
strTempstrTemp=strTemp & "</option>" 
response.write strTemp 
rsClass.movenext 
loop 
end if 
rsClass.close 
set rsClass=nothing 
end sub 
%>  

附：表结构（表名为zl_class，以下是其包含字段名和字段类型） 
ClassID ClassName ParentID ParentPath Depth RootID Child PrevID NextID OrderID 
自动编号 文本 数字 文本 数字 数字 数字 数字 数字 数字

[返回]