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
%>
轉載的一個遞歸函數，比較典型的應用，沒有特別算法，目前我們一般常見的無限級分類函數均大同小異。簡單整理了一下，包括示例打包getCatagory.rar
*大類1
└二級小類1
└三級小類1
└四級小類1
└五級小類1
*大類2
└二級小類2
*大類3
數據庫說明:數據庫db.mdb,classTable表的結構:classid類別ID（自動增長） parentid 父級ID 默認為0 (0代表最高級) classname類別名,classdepth是為了記錄類別的級數 ———————————————-
| classid| classname| parentid | classdepth |
———————————————-
主要代碼:
復制代碼 代碼如下:
//先取出最高級(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
%>
