ASP 无限级分类实现

ASP递归无限级分类函数

 
<% 
'函数：getCatagory 
'功能：获得分类列表 
'参数：cat_arr -> 分类数组(Rscordset:id:分类编号,pid:上级分类,classname:分类名称,childs:子分类) 
' 按此输出些sql语句，用getRows获取得到的数据 
' cat_pid -> 上级分类编号 
' cat_childs -> 下级分类编号 
' cat_select -> 选择的分类 
' cat_dir -> 分类级别 
'返回：返回分类列表(Option) 

dim conn,cmd,rs,cat_arr 
Set conn = Server.CreateObject("ADODB.Connection") 
Set cmd = Server.CreateObject("ADODB.Command") 

conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("db1.mdb") 
cmd.ActiveConnection = conn 
cmd.CommandText = "Select * from cate order by id desc" 
Set rs = cmd.Execute 
cat_arr = rs.GetRows() 
Set rs = Nothing 
Set cmd = Nothing 
Set conn = Nothing 

getCatagory cat_arr,0,"","","","{$cat.dir}├─<a href=""?id={$cat.id}"" title=""分类级别：{$cat.dir} 分类编号：{$cat.id} 分类上级编号：{$cat.pid} 分类名称：{$cat.name} 分类子分类：{$cat.childs}"">{$cat.name} </a><br />"&vbcrlf 

function getCatagory(byval cat_arr,byval cat_pid,byval cat_childs,byval cat_select,byval cat_dir,byval format) 
dim i,tmp 
if isArray(cat_arr) then 
for i=0 to ubound(cat_arr,2) 
if cat_arr(1,i) = cat_pid and instr("," & cat_childs & ",","," & cat_arr(0,i) & ",") = 0 then 
tmp = format 
if instr(tmp,"{$cat.dir}")>0 then tmp = replace(tmp,"{$cat.dir}",cat_dir) 
if instr(tmp,"{$cat.id}")>0 then tmp = replace(tmp,"{$cat.id}",cat_arr(0,i)) 
if instr(tmp,"{$cat.pid}")>0 then tmp = replace(tmp,"{$cat.pid}",cat_arr(1,i)) 
if instr(tmp,"{$cat.name}")>0 then tmp = replace(tmp,"{$cat.name}",cat_arr(2,i)) 
if instr(tmp,"{$cat.childs}")>0 then tmp = replace(tmp,"{$cat.childs}",cat_arr(3,i)) 
response.write tmp 
call getCatagory(cat_arr,cat_arr(0,i),cat_childs,cat_select,cat_dir & "│",format) 
end if 
next 
end if 
end function 
%> 

//先取出最高级(parentid=0)的分类 

<% 
set conn=server.createobject("adodb.connection") 
conn.open "Provider=Microsoft.Jet.Oledb.4.0;data source="&server.MapPath("db.mdb") 
set rs1=server.createobject("adodb.recordset") 
sql1="select * from Classtable where parentid=0 order by classid" 
rs1.open sql1,conn,1,1 
if rs1.eof or rs1.bof then 
response.write"还没分类!" 
else 
while not rs1.eof 
id1=rs1("classid") 
name1=rs1("classname") 

response.write "*<a href='class.asp?id="&id1&"&name="&name1&"‘>"&name1&"</a><br>" 
parentid1=rs1("parentid") 
call reclass(id1) 
rs1.movenext 
wend 
end if 
rs1.close 
set rs1=nothing 


sub reclass(id) 
‘递归调用函数,生成一个类别代码 
set rs=server.createobject("adodb.recordset") 
sql="select * from classtable where parentid="&id 
rs.open sql,conn,1,1 
i=1 
while not rs.eof 
id0=rs("classid") 
classname0=rs("classname") 
parentid0=rs("parentid") 
classdepth0=rs("classdepth") 
brstr="" 
for j=1 to classdepth0 
brstr=" "&brstr 
next 
response.write(brstr&"└<a href='class.asp?id="&id0&"&name="&classname0&"‘>"&classname0&"</a><br>") 
call reclass(id0) 

rs.movenext 
i=i+1 
wend 
rs.close 
set rs=nothing 
end sub 

if request("a")="add" then 
call add 
end if 
if request("name")<>"" then 
%> 
<table width="80%" align="center" cellpadding="0″ cellspacing="0″> 
<form action="class.asp?a=add&id=<%=request("id")%>" method="post"> 
<tr> 
<td> </td> 
<td>在<font color="#FF0000″><%=request("name")%></font>添加小类</td> 
</tr> 
<tr> 
<td>类别名:</td> 
<td><input name="classname" type="text" id="classname"></td> 
</tr> 
<tr> 
<td> </td> 
<td><input type="submit" name="Submit" value="提交"></td> 
</tr> 
</form> 
</table> 
<%end if 
sub add '添加类别 
id=request("id") 
classname=request("classname") 
set rs=server.createobject("adodb.recordset") 
rs.open "select parentid,classdepth from classtable where classid="&id,conn,1,1 
parentid=rs(0) 
classdepth=rs(1)+1 
rs.close 
set rs=nothing 
sql="INSERT INTO classtable (classname,parentid,classdepth) values ('"&classname&"‘,"&id&","&classdepth&")" 
conn.execute sql 
response.Write"<script>alert('添加成功!');location.href='class.asp';</script>" 
end sub 
%>