<!--
看到論壇里有人發了一個樹型菜單,需者甚眾,看了一下演示,
似乎不難實現,趁著周六沒事,便也寫了一個出來
理論上支持無限級分類,發上來與大家分享!!
'--------------------------
名稱:無限級分類樹型菜單演示
作者:y0h
最后更新:2004-09-19 22:40
環境:ASP+ACCESS

'//----------List表定義
'Create Table List(ID AUTOINCREMENT,ParentID long,Title Text(50),Url Text(50),Flag bit,ChildNum Long,Target Text(10))
'--------------------------
-->
<style Type=Text/Css>
body,td{font-size:13px;}
a:link { color: #442200; text-decoration: none}
a:visited { color: #444400; text-decoration: none}
a:hover { color: #442200; text-decoration: underline overline; background-color: #FFFF00}
a.link1:link { color: #FF0000; text-decoration:none}
a.link1:visited { color: #FF0000; text-decoration: none}
a.link1:hover { color: #FF0000; text-decoration: none; background-color: #eeeeee}
</Style>
<!-- 有人問同一頁面不同鏈接的不同風格怎么做,就是這里啦 -->

<!-- 添加節點表單 -->
<div align="center" id=load style="display:none;position: absolute;">
<TABLE bgcolor=ffffee width=250 Style="border:1px solid #dd8888;"><FORM METHOD=POST ACTION="" name=form1>
<tr><td align="center">添加節點</td></tr>
<TR><TD align="center">
<INPUT TYPE="hidden" Name="ParentID">
標題:<INPUT TYPE="text" NAME="Title"><BR>
鏈接:<INPUT TYPE="text" NAME="Url"><BR>
目標:<INPUT TYPE="text" NAME="Target" Style="width:70px">
<SELECT NAME="" Style="width:75px" OnChange="javascript:Target.value=this.options[this.selectedIndex].value;">
<!-- 有人問用下拉列表改變文本框的值怎么做,就是這里了 -->
<option value="">Default</option>
<option value="Right">Right</option>
<option value="_black">_black</option>
<option value="_Top">_Top</option>
<option value="_parent">_parent</option>
<option value="_self">_self</option>
</SELECT>
</td></tr><tr><td align="center">
<INPUT TYPE="submit" Name="提交" value="提交">
<INPUT TYPE="Button" onclick="javascript:load.style.display='none'" value="取消">
</TD>
</TR></FORM>
</TABLE>
</div>
<!-- 添加節點表單結束 -->

<%
'連接數據庫
set conn=server.createobject("ADODB.Connection")
conn.open "provider=microsoft.jet.oledb.4.0;data source="&server.mappath("File.mdb")

'//----------操作分支
Action=Request("Action")
Select Case Action
Case "Add":If Request("ParentID")<>"" Then Add
Case "Del": Del
Case "Open":Open
Case Else:
End Select
'//----------顯示列表
Public List
Set Rs=Conn.Execute("Select * From [List]")
If Not Rs.Eof Then
List =Rs.GetRows
Max=Conn.Execute("Select Count(ParentID) From List Where ParentID=0")(0)
Set Rs=Nothing
Set Conn=Nothing
CheckList 0,Max,""
Else
Set Rs=Nothing
Set Conn=Nothing
End If
Response.Write "<a href=# onclick='javascript:form1.action=""List.asp?action=Add"";form1.ParentID.value=0;load.style.left=(document.body.scrollWidth-300)/2;load.style.top=(document.body.scrollHeight)/2;load.style.display="""";'>添加根</a><BR>"
'//------------顯示列表函數
FuncTion CheckList(ParentID,Cs,Str1)
Dim j
j=0
For i=0 To Ubound(List,2)
If List(1,i)=ParentID Then
Response.write(Str1)
If j<Cs-1 Then Str2="├" Else Str2="└"
If List(5,i)>0 Then Str2="<a class=Link1 href='List.asp?action=Open&Id="&List(0,i)&"'>"&Str2&"</a>"
If List(5,i)>0 And List(4,i)=False Then Str2="<b>"&Str2&"</b>"
Response.Write(Str2)

Response.Write "<a Href='"&List(3,i)&"' target='"&List(6,i)&"'>"&List(2,i)&"</a>"&VBcrlf
'添加節點鏈接
Response.Write "<a title='添加"&List(2,i)&"的子節點' href='#' onclick='javascript:add("&List(0,i)&");'>添加</a>"&Vbcrlf
Response.Write "<a Title=""刪除此節點"&VBCRLF&"此節點的子節點將向上遞進一層!"" href='javascript:Del("&List(0,i)&");'>刪除</a><BR>"
If List(4,i)=True Then
If j<Cs-1 Then CheckList List(0,i),List(5,i),Str1&"┆" Else CheckList List(0,i),List(5,i),Str1&""'關鍵所在,遞歸調用
End If
j=j+1
End IF
Next
End Function

'//-----------添加函數
Function Add
Parent=CLng(Request("ParentID"))
Title=Replace(Request("Title"),"'","''")
Url=Replace(Request("URL"),"'","''")
Target=Replace(Request("Target"),"'","''")
If Title="" Or Url="" Then
Response.Write "至少有一個必須參數沒有指定值 <a href=List.asp>返回</a>"
Response.End
Exit Function
End If
Sql="Insert Into List (ParentID,Title,Url,Target) Values ("&Parent&",'"&Title&"','"&Url&"',' "&Target&"')"
Conn.Execute(Sql)
If Parent<>0 Then
Sql="Update List Set ChildNum=ChildNum+1 Where ID="&Parent
Conn.Execute(Sql)
End IF
End Function

'//-----切換節點狀態
Function Open
Sql="Update List Set Flag=Not Flag Where ID="&Clng(Request("Id"))
Conn.Execute(Sql)
End Function
'//-----------刪除節點
Function Del
On Error Resume Next
Id=Clng(Request("ID"))
ParentID=Conn.Execute("Select ParentID From List Where ID="&ID)(0)
Num=Conn.Execute("Select Count(ID) From List Where parentID="&ID)(0)
Conn.Execute("Update List Set ChildNum=ChildNum-1+"&Num&" Where ID="&ParentID)
Conn.Execute("Update List Set ParentID="&ParentID&" Where ID in (Select ID From List Where ParentID="&ID&")")
Conn.Execute("Delete From List Where ID="&ID)
If Err.Number<>0 Then
Response.Write "您做的操作無效,可能是該項已經刪除!! <a href=List.asp>返回</a>"
Response.End
End If
End Function
%>
<SCRIPT LANGUAGE="JavaScript">
<!--
function add(ID)
{
form1.action='List.asp?action=Add';
form1.ParentID.value=ID;
load.style.left=(document.body.scrollWidth-300)/2;
load.style.top=(document.body.scrollHeight-100)/2;
load.style.display="";//有人問控制層的隱顯怎么做,就是這里啦
}
function Del(ID)
{
if(confirm('刪除此節點將使此節點的子節點向上遞進一層\n確定要繼續嗎?'))
{window.location.href='List.asp?Action=Del&Id='+ID;}//有人問刪除確認怎么做,就是這里啦}
//-->
</SCRIPT>

沒有做美化,沒有加其它功能,需要者可以自己改好了!

Create Table List(ID AUTOINCREMENT,ParentID long,Title Text(50),Url Text(50),Flag bit,ChildNum Long,Target Text(10))

直接在查詢里執行就可以得到List表!!

下面是對表的說明

Id 自動編號
ParentID 長整形
Title 文本
Url 文本
Flag 布爾
ChildNum 長整形
Target 文本,允許空符串