程序调用：
<%
Dim rss,u
Set rss = Server.CreateObject("Adodb.RecordSet")
rss.Open "select ID,fatherID,name from [Select_Menu] order by id",Conn,1,1
Response.Write "<select name='FatherID'><option value='0'> - 0.顶级菜单</option>"&GetListTree&"<select>"
rss.Close
%>

数据库结构：
Select_Menu：
id,fatherid,name
fatherid=0,置为顶级菜单

函数：
<%
'无限级分类菜单树Select输出函数
Function GetListTree
    Dim Result,i
    Redim u(rss.RecordCount,3)
    for i = 1 to rss.RecordCount
        u(i - 1,0) = rss("ID")
        u(i - 1,1) = rss("fatherID")
        u(i - 1,2) = rss("Name")
        rss.MoveNext
    next
    'rss.moveFirst
    for i = 0 to uBound(u) - 1
        If Int(u(i,1)) = 0 Then
		    '如果ID=FatherID则定位其父类
		    if u(i,0)=fatherid then
			    selected="Selected"
			else
			    selected=""
			end if
            Result = Result &"<option "&Selected&" value='"& u(i,0) &"'> ◢ "& u (i ,2) &"</option>"& vbcrlf & SunSorts(u(i ,0), 0)
        End If
    next
    GetListTree = Result
End Function

Function SunSorts(who,SunLevel)
        Dim selected
        Dim Result,i,sp,EndID
        for i = 0 to SunLevel
            sp = sp &"--"
        next
        for i = 0 to uBound(u) - 1
            If Int(u(i,1)) = Int(who) Then
                EndID = u(i ,0)
			else
                EndID = fatherID
            End If
        next
        for i = 0 to uBound(u) - 1
            If Int(u(i,1)) = Int(who) Then
                If u(i ,0) - EndID = 0 Then
                    Result = Result &"<option "&selected&" value='"& u(i,0) &"'>"& sp &"┕"& u(i ,2) & "</option>"& vbcrlf & SunSorts(u(i ,0),SunLevel + 1)
                Else
                    Result = Result &"<option "&selected&" value='"& u(i,0) &"'>"& sp &"┝  "& u(i ,2) & "</option>"& vbcrlf & SunSorts(u(i ,0),SunLevel + 1)
                End If
            End If
        next
        SunSorts = Result
End Function
%>