恳请本版几大高手来看看我这个问题。

Question

（1）怎样设计类似于windows资源管理器的树型结构，可以无极限的延伸树的层级和层级的子层级，搜索了好长时间没有结果。我想用数据表实现但是没有一个好的数据表结构和算法，看了用XML做数据保存的例子程序无法下载，真是郁闷！！！不知道在VB中能不能实现这个问题。
（2）或者给一个用TreeView控件遍历整个硬盘分区的例子来看看。

Answer 1

一个Drive和一个treeview再加一个imagelist
Option ExplicitPrivate Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As LongPrivate Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePrivate Const MAX_PATH As Long = 260
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type'去掉\0之后的字符
Function Trim0(ByRef FileName As String) As String
    Dim TempLen As Long
    TempLen = InStr(1, FileName, vbNullChar)
    If TempLen Then
        Trim0 = Left(FileName, TempLen - 1)
    Else
        Trim0 = FileName
    End If
End Function'得到第一个子目录
Function GetFirstChildDir(ByRef Path As String) As String
    Dim TempPath As String
    TempPath = Path & IIf(Right(Path, 1) <> "\", "\", "") & "*.*"
    
    Dim hFindFile As Long
    Dim fd As WIN32_FIND_DATA
    Dim TempStr As String
    hFindFile = FindFirstFile(TempPath, fd)
    If hFindFile = 0 Then Exit Function
    Do
        If fd.dwFileAttributes And vbDirectory Then
            TempStr = Trim0(fd.cFileName)
            'Debug.Print TempStr
            If TempStr <> "." And TempStr <> ".." Then
                'Debug.Print TempStr
                FindClose hFindFile
                GetFirstChildDir = TempStr
                Exit Function
            End If
        End If
    Loop While FindNextFile(hFindFile, fd)
    FindClose hFindFile
    
End Function'得到所有子目录
Function GetChildDir(ByRef Path As String, Optional ByRef ItemCount As Long) As String()
    Dim TempPath As String
    TempPath = Path & IIf(Right(Path, 1) <> "\", "\", "") & "*.*"
    
    Dim Arr() As String
    Dim ArrSize As Long
    Dim ArrMaxSize As Long
    Const ArrAdd = &H10
    ArrMaxSize = ArrAdd
    ReDim Arr(0 To ArrMaxSize - 1)
    
    Dim I As Long
    
    Dim hFindFile As Long
    Dim fd As WIN32_FIND_DATA
    Dim TempStr As String
    hFindFile = FindFirstFile(TempPath, fd)
    If hFindFile = 0 Then GetChildDir = Arr: Exit Function
    Do
        If fd.dwFileAttributes And vbDirectory Then
            TempStr = Trim0(fd.cFileName)
            'Debug.Print TempStr
            If TempStr <> "." And TempStr <> ".." Then
                'Debug.Print TempStr
                
                If ArrSize >= ArrMaxSize Then
                    ArrMaxSize = ArrMaxSize + ArrAdd
                    ReDim Preserve Arr(0 To ArrMaxSize - 1)
                End If
                
                '排序
                For I = 0 To ArrSize - 1
                    If StrComp(TempStr, Arr(I), vbTextCompare) < 0 Then
                        Exit For
                    End If
                Next I
                If I <> ArrSize Then
                    CopyMemory ByVal VarPtr(Arr(I + 1)), ByVal VarPtr(Arr(I)), (ArrSize - I) * 4
                    CopyMemory ByVal VarPtr(Arr(I)), 0&, 4
                End If
                Arr(I) = TempStr
                
                ArrSize = ArrSize + 1
                
            End If
        End If
    Loop While FindNextFile(hFindFile, fd)
    FindClose hFindFile
    'Stop
    
    ItemCount = ArrSize
    GetChildDir = Arr
    
End FunctionFunction MyFullPath(ByVal Node As Node) As String
    If Node Is Nothing Then Exit Function
    Dim TempStr As String
    TempStr = Node.Text
    Set Node = Node.Parent
    Do Until Node Is Nothing
        TempStr = Node.Text & "\" & TempStr
        Set Node = Node.Parent
    Loop
    MyFullPath = TempStr
End FunctionPrivate Sub Drive1_Change()
    Dim tN As Node
    tvwDir.Nodes.Clear
    Set tN = tvwDir.Nodes.Add(, , , UCase(Left(Drive1.Drive, 2)), 1, 2)
    'Debug.Print Drive1.Drive
    
    Dim TempStr As String
    TempStr = GetFirstChildDir(tN.Text)
    If TempStr <> "" Then
        tvwDir.Nodes.Add tN.Index, tvwChild, , TempStr, 1, 2
        tN.Expanded = True
    End If
    On Error Resume Next
    tvwDir.SetFocus
    On Error GoTo 0
    
End SubPrivate Sub Form_Load()
    Drive1_Change
End SubPrivate Sub Form_Resize()
    If Me.WindowState = 1 Then Exit Sub
    On Error Resume Next
    
    Drive1.Move 0, 0, Me.ScaleWidth
    tvwDir.Move 0, Drive1.Height, Me.ScaleWidth, Me.ScaleHeight - Drive1.Height
    
End SubPrivate Sub tvwDir_Expand(ByVal Node As Node)
    Dim Dirs() As String, DirCount As Long
    Dim I As Long
    Dim Idx As Long
    Dirs = GetChildDir(MyFullPath(Node), DirCount)
    If DirCount = 0 Then
        For I = 0 To Node.Children - 1
            tvwDir.Nodes.Remove Node.Child.Index
        Next I
        Exit Sub
    End If
    Idx = 0
    'Debug.Print "tvwDir_Expand:" & Node.FullPath
    'Stop
    
    Dim Exist As Boolean
    Exist = False
    Dim TempStr As String
    Dim tN As Node
    Set tN = Node.Child
    '这是一个算法问题：如何用一个有序列表去更新原来的有序列表
    Do
        Select Case StrComp(Dirs(Idx), tN.Text, vbTextCompare)
        Case Is < 0
            Set tN = tvwDir.Nodes.Add(tN.Index, tvwPrevious, , Dirs(Idx), 1, 2)
            TempStr = GetFirstChildDir(MyFullPath(tN))
            If TempStr <> "" Then
                tvwDir.Nodes.Add tN.Index, tvwChild, , TempStr, 1, 2
            End If
            Exist = True
            Idx = Idx + 1
            If Idx >= DirCount Then Exit Do
        Case 0
            If tN.Children = 0 Then
                TempStr = GetFirstChildDir(MyFullPath(tN))
                If TempStr <> "" Then
                    tvwDir.Nodes.Add tN.Index, tvwChild, , TempStr, 1, 2
                End If
            End If
            If tN.Next Is Nothing Then
                For I = Idx + 1 To DirCount - 1
                    Set tN = tvwDir.Nodes.Add(Node.Index, tvwChild, , Dirs(I), 1, 2)
                    TempStr = GetFirstChildDir(MyFullPath(tN))
                    If TempStr <> "" Then
                        tvwDir.Nodes.Add tN.Index, tvwChild, , TempStr, 1, 2
                    End If
                Next I
                Exit Do
            End If
            Set tN = tN.Next
            Exist = False
            Idx = Idx + 1
            If Idx >= DirCount Then Exit Do
        Case Else 'is>0
            If tN.Next Is Nothing Then
                If Exist = False Then tvwDir.Nodes.Remove tN.Index
                For I = Idx To DirCount - 1
                    Set tN = tvwDir.Nodes.Add(Node.Index, tvwChild, , Dirs(I), 1, 2)
                    TempStr = GetFirstChildDir(MyFullPath(tN))
                    If TempStr <> "" Then
                        tvwDir.Nodes.Add tN.Index, tvwChild, , TempStr, 1, 2
                    End If
                Next I
                Exit Do
            Else
                Set tN = tN.Next
                If Exist = False Then tvwDir.Nodes.Remove tN.Previous.Index
                Exist = False
            End If
        End Select
    Loop
    
End Sub

Answer 2

请到这里去下载一个实例看看吧，也许会对你有帮助。http://www.zjonline.com.cn/vbbible/index.html
推荐楼上莫依MM的

Answer 3

怎么没有看见online(龙卷风)呢.

Answer 4

1.
http://www.microsoft.com/china/community/Column/21.mspxhttp://www.vbaspnew.com/ziyuan/y/qt/bak.htm
o017_zm020.zip 利用这个程序可以让你方便的管理你所收集的源程序，VBCODE网站50几周来排行第一的源程序。强烈推荐！  看看这个例子

Answer 5

树形结构在开发中的应用
撰文： 李洪根
http://dev.csdn.net/develop/article/23/23258.shtm

Answer 6

daisy8675(莫依) (★★)
starsoulxp(星魂.NET) (★★)
dongge2000(※秋日私语※：非[版务].灌！) (★)
zyl910(910：分儿，我又来了！) (★★★)
online(龙卷风V3.0--笑傲江湖)(★★★★★)楼上的几位大版主，能否帮我解决一个困扰我一年的贴子。
项目开始时思考这个问题，项目快结束了，还在思考这个问题。

Answer 7

我的贴子
http://community.csdn.net/Expert/topic/3807/3807782.xml?temp=.9537928

Answer 8

基本上会用递归来解决类似的问题
数据结构一般例如：
假设表名为T_DIR,其中会有这两个基本字段
   ID：各节点的唯一编码
   PID：父节点ID，如果为空，表示没有父节点，可以用它来做一个根。
   可以根据需要加入节点的描述和其它属性。算法：
一个函数名为 fTreeLoadS  递归入口函数
一个函数名为 fTreeLoadT  递归主体函数
Private Function fTreeLoadS()Dim recT As New ADODB.Recordset
Dim nodeT As Node
'查询所有根节点
recT.Open "select * from t_dir where pid <> ''", connDate, 1, 4
Do While Not recT.EOF
   Set nodeT = Me.TreeView1.Nodes.Add(, , "R" & recT.Fields("id"), recT.Fields("id"))
   '装入根节点的下级节点
   fTreeLoadF recT.Fields("id")
Loop
recT.Close
End FunctionPrivate Function fTreeLoadF(pID As String)
Dim recT As New ADODB.Recordset
Dim nodeT As Node
'查询此节点的下级节点
recT.Open "select * from t_dir where pid = '" & pID & "'", connDate, 1, 4
Do While Not recT.EOF
   Set nodeT = Me.TreeView1.Nodes.Add("R" & pID, tvwChild, "R" & recT.Fields("id"), recT.Fields("id"))
   fTreeLoadF recT.Fields("id")    '装入此节点的下级节点
Loop
recT.CloseEnd Function装入目录的算法差不多，就是你要得到当前目录的列表，然后一级级搜索下去。
建议你的装载目录内容的代码在用户展开节点时执行，这样在第一次装入目录时，用户不用等太久。