ASP无限级分类方法搜集,欢迎补充啊~ - 编程论坛

例:
  游戏娱乐
      ┖音乐欣赏
            ┖港台音乐
            ┖欧美音乐
                  ┖欧美古典音乐
  电脑网络
      ┖电脑商家

用链表的方法实现！建库如下：

  ----------------------------
  ID　　　　自动编号　主键
  类别名称　文本
  上级类别　数字
  ----------------------------

  上级类别是其它类别名称的ID，根类别是0

  查询时：

  RS   ==>   "Select   *   Form   类别   Where   上级类别=0;"
  　递归开始：
  　　RS1   ==>   "Select  *  From  类别  Where  上级类别 ="&RS("ID")
  　　　"Select   *   From   类别   Where   上级类别="&RS1("ID")
  　递归结束

'*************************************************************************
  '返回树型样式的类别列表
  '参数：
  '   1.FirstTypeID   :起始类别ID
  '   2.Space               :递归过程用参数，向右缩进空格数
  '   3.IsFirst           :递归过程用参数，永设True
  '   4.AddLink           :链接文件名
  '*************************************************************************
      Function   GetTypeAsTree(FirstTypeID,Space,IsFirst,AddLink)
          Dim   SQL,   RS,   S

          Set   RS=   Server.CreateObject("ADODB.Recordset")
          SQL="SELECT   *   FROM   Type   WHERE   所属类别="   &   FirstTypeID   &   "   Order   By   优先级   Desc,   ID;"
          RS.Open   SQL,Conn,1,1
          If   IsFirst   Then   S   =   S   +   "<Table   Align='Center'>"

          Do   While   Not   RS.Eof
              S   =   S   +   "<TR>"
              S   =   S   +   "<TD   Align='left'>"   +   String(Space,"　")   +   IIF(IsFirst,"","∟")   +   "<A   Href='"   +   AddLink   +   "?TypeID="   &   RS("ID")   &   "'>"   +   RS("类别名称")   +   "</A></TD>"
              S   =   S   +   "</TR>"
              S   =   S   +   GetTypeAsTree(RS("ID"),Space+1,False,AddLink)
              RS.MoveNext
          Loop

          If   IsFirst   Then   S   =   S   +   "</Table>"
          RS.Close
          Set   RS=Nothing

          GetTypeAsTree   =   S
      End   Function
  '****************************************************************************

  Function   IIF(A,B,C)
      If   A   Then   IIF=B   Else   IIF=B
  End   Function

-----------------------------------------------------------------------------------------------------------ASP无限分类数据库版

程序代码：

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.
<html xmlns="http://www.
    <head>
        <title>ASP无限分类数据库版</title>
        <meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
        <meta name="Generator" content="EditPlus">
        <meta name="Author" content="Dicky;QQ:25941">
        <meta name="Keywords" content="Dicky;QQ:25941;ASP无限分类数据库版">
        <meta name="Description" content="Dicky;QQ:25941;ASP无限分类数据库版">
    </head>

    <body>
        <%
        Const IsSql = 0     '定义数据库类型,1为SQL Server,0为Access
        Function OpenConn(Conn)      '打开数据库连接
            Dim ConnStr
            If IsSql = 1 Then '如果是SQL Server数据库
                'SQL Server数据库连接参数:用户名、用户密码、数据库名、连接名（本地用local，外地用IP）
                Dim SqlUsername,SqlPassword,SqlDatabaseName,SqlLocalName
                SqlUsername = "sa"
                SqlPassword = ""
                SqlDatabaseName = "TreeDb"
                SqlLocalName = "(local)"
                ConnStr = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlLocalName & ";"
            Else   '如果是Access数据库
                Dim Db
                '第一次使用请修改本处数据库地址并相应修改数据库名称，如将Dicky.mdb修改为Dicky.asp(防止恶意下载Access数据库)
                Db = "TreeDB.mdb"
                ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(Db)
            End If
            On Error Resume Next
            Set Conn = Server.CreateObject("ADODB.Connection")
            Conn.Open ConnStr
            If Err Then
        '         Err.Clear
                Set Conn = Nothing
                Response.Write "数据库连接出错，请检查连接字串。"
                Response.End
            End If
        End Function

        Function CloseConn(Conn)   '关闭数据库连接
            If IsObject(Conn) Then
                Conn.Close
                Set Conn = Nothing
            End If
        End Function

        Function Echo(Str) '输出字符串并换行
            Response.Write Str & VbCrlf
        End Function

        Call OpenConn(Conn)

        '定义第一级分类
        Sub MainFl()
            Dim Rs
            Set Rs = Conn.Execute("SELECT ClassID,ClassName FROM Class WHERE ParentClassID IS NULL")
            If Not Rs.Eof Then
                Do While Not Rs.Eof
                    Echo("<div><label id=""" & Trim(Rs("ClassID")) & """>+" & Trim(Rs("ClassName")) & "</label>")
                    Call Subfl(Rs("ClassID"),"|-") '循环子级分类
                    Echo("</div>")
                Rs.MoveNext
                If Rs.Eof Then Exit Do '防上造成死循环
                Loop
            End If
            Set Rs = Nothing
        End Sub
        '定义子级分类
        Sub SubFl(FID,StrDis)
            Dim Rs1
            Set Rs1 = Conn.Execute("SELECT ClassID,ClassName FROM Class WHERE ParentClassID = '" & FID & "'")
            If Not Rs1.Eof Then
                Do While Not Rs1.Eof
                    Echo("     <div id=""" & Trim(Rs1("ClassID")) & """>" & StrDis & Trim(Rs1("ClassName")) & "</div>")
                    Call SubFl(Trim(Rs1("ClassID")),"| " & Strdis) '递归子级分类
                Rs1.Movenext:Loop
                If Rs1.Eof Then
                    Rs1.Close
                    Exit Sub
                End If
            End If
            Set Rs1 = Nothing
        End Sub

        '最后直接调用MainFl()就行了

        MainFl()

        Call CloseConn(Conn)%>
    </body>
</html>

还有一些:限于篇幅,发个连接~
ASP无限级分类:[url]http://www.[/url]
ASP无限级分类实现源码:[url]http://www.[/url]
欢迎大家补充啊...