Access2003 中使用 无限分类 模块函数 ,可用在查询中
Option Compare Database
'表结构 classid(int), parentid(int) 要求:两者都>0 且不相等 且 classid不能是自己和子孙节点
'生成查询后的结构 classid(int),parentid(int),ParentPath(string),ChildPath(string),Depth(int),Child(int)
'表查询中使用 SELECT ParentPath("newsClass",parentid) AS ParentPath, ChildPath("newsClass",classid) AS ChildPath, Depth("newsClass",parentid) AS Depth, Child("newsClass",classid) AS Child, * FROM newsClass;
'--ParentPath 父类别路径
Public Function ParentPath(TableName As String, ParentId As Integer)
Dim sPath As String
Call getParentPath(TableName, ParentId, sPath)
ParentPath = sPath
End Function
'--ChildPath 子类别路径
Public Function ChildPath(TableName As String, ClassId As Integer)
Dim sPath As String
Call getChildPath(TableName, ClassId, sPath)
ChildPath = sPath
End Function
'--Depth 深度
Public Function Depth(TableName As String, ParentId As Integer)
Dim iDepth As Integer
iDepth = 0
Call getDepth(TableName, ParentId, iDepth)
Depth = iDepth
End Function
'--Child 子类别数量
Public Function Child(TableName As String, ClassId As Integer)
Dim iChild As Integer
iChild = 0
Call getChild(TableName, ClassId, iChild)
Child = iChild
End Function
'获取父路径 -- 递归法
'TableName : 表名,
'ParentId : 父类别id
'sPath : 父路径 (引用) 如: "0,1,5,9,10"
Function getParentPath(ByVal TableName As String, ByVal ParentId As Integer, ByRef sPath As String)
Set rs = CurrentDb.OpenRecordset("select classid,parentid from " & TableName & " where classid = " & ParentId)
If Not (rs.EOF) Then
If (ParentId <> rs("parentid")) Then '父类id 不能是自己
Call getParentPath(TableName, rs("parentid"), sPath)
End If
End If
If (sPath <> "") Then
sPath = sPath & ","
End If
sPath = sPath & ParentId
rs.Close
Set rs = Nothing
End Function
'获取子路径 -- 递归法
'TableName : 表名,
'ClassId : 当前类别id
'sPath : 子类别路径 (引用) 如: "0,1,5,9,10"
Function getChildPath(ByVal TableName As String, ByVal ClassId As Integer, ByRef sPath As String)
Set rs = CurrentDb.OpenRecordset("select classid,parentid from " & TableName & " where parentid = " & ClassId)
Do While Not rs.EOF
If (ClassId <> rs("classid")) Then '子类id 不能是自己
If (sPath <> "") Then
sPath = sPath & ","
End If
sPath = sPath & rs("classid")
Call getChildPath(TableName, rs("classid"), sPath)
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function
'获取深度 -- 递归法
'TableName : 表名,
'ParentId : 父类别id
'iDepth : 深度 (引用)
Function getDepth(ByVal TableName As String, ByVal ParentId As Integer, ByRef iDepth As Integer)
Set rs = CurrentDb.OpenRecordset("select classid,parentid from " & TableName & " where classid = " & ParentId)
If Not (rs.EOF) Then
If (ParentId <> rs("parentid")) Then '父类id 不能是自己
iDepth = iDepth + 1
Call getDepth(TableName, rs("parentid"), iDepth)
End If
End If
rs.Close
Set rs = Nothing
End Function
'获取孩子个数 -- 递归法
'TableName : 表名,
'ClassId : 当前类别id
'iChild : 孩子数量 (引用)
Function getChild(ByVal TableName As String, ByVal ClassId As Integer, ByRef iChild As Integer)
Set rs = CurrentDb.OpenRecordset("select classid,parentid from " & TableName & " where parentid = " & ClassId)
Do While Not rs.EOF
If (ClassId <> rs("classid")) Then '子类id 不能是自己
iChild = iChild + 1
Call getChild(TableName, rs("classid"), iChild)
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function