动易无限级分类代码

把动易里的无限级分类代码整理了一下发出，给大伙参考一：
'**************************************************
'函数名：GetClass_Option
'作  用：栏目下拉菜单
'参  数：
' ClassID ---- 当前分类ID
'返回值：栏目下拉菜单
'**************************************************
Function GetClass_Option(ClassID)
    Dim rsClass, sqlClass, strClass_Option, tmpDepth, i, ClassNum
    Dim arrShowLine(40)
   
    'ClassID 分类ID
    'ClassName  栏目名称
    'ParentID 父ID
    'Depth 栏目深度
    'RootID 根ID
    'Child 子栏目数
    'arrChildID 所有子栏目
    'PrevID 上一个栏目ID
    'NextID 下一个栏目ID
    'OrderID 排序ID
    For i = 0 To UBound(arrShowLine)
        arrShowLine(i) = False
    Next
    sqlClass = "Select ClassID,ClassName,ParentID,Depth,RootID,Child,arrChildID,PrevID,NextID,OrderID from PE_Class Order BY RootID,OrderID"
    Set rsClass = Conn.Execute(sqlClass)
    If rsClass.BOF And rsClass.EOF Then
        strClass_Option = strClass_Option & "<option value=''>请先添加栏目</option>"
    Else
        Do While Not rsClass.EOF
            ClassNum = ClassNum + 1
            tmpDepth = rsClass("Depth")
            If rsClass("NextID") > 0 Then
                arrShowLine(tmpDepth) = True
            Else
                arrShowLine(tmpDepth) = False
            End If
           
            strClass_Option = strClass_Option & "<option value='" & rsClass("ClassID") & "'"
           
            if rsClass("ClassID")=ClassID then
               strClass_Option = strClass_Option & " selected"
            end if
            strClass_Option = strClass_Option & ">"
           
            If tmpDepth > 0 Then
                For i = 1 To tmpDepth
                    strClass_Option = strClass_Option & "  "
                    If i = tmpDepth Then
                        If rsClass("NextID") > 0 Then
                            strClass_Option = strClass_Option & "├ "
                        Else
                            strClass_Option = strClass_Option & "└ "
                        End If
                    Else
                        If arrShowLine(i) = True Then
                            strClass_Option = strClass_Option & "│"
                        Else
                            strClass_Option = strClass_Option & " "
                        End If
                    End If
                Next
            End If
            strClass_Option = strClass_Option & rsClass("ClassName")
            strClass_Option = strClass_Option & "</option>"
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing
    GetClass_Option = strClass_Option
End Function