动易无限级分类代码
把动易里的无限级分类代码整理了一下发出，给大伙参考一：'**************************************************
'函数名：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
