Directory Tree - Generates a list of subdirectories.

[fafalone]

Found this:
http://www.fenlog.com/?mod=wap&act=View&id=16

Basically it implements FindFirstFile/FindNextFile in VB6 using the NtQueryDirectoryFile API. Cool stuff.

Here's a cleaned up version without all the chinese

Option Explicit

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Type UNICODE_STRING
    uLength As Integer
    uMaximumLength As Integer
    pBuffer As Long
End Type

Private Type IO_STATUS_BLOCK
    Status As Long
    uInformation As Long
End Type

Private Type OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As Long
    Attributes As Long
    SecurityDescriptor As Long
    SecurityQualityOfService As Long
End Type

Private Type FILE_BOTH_DIRECTORY_INFORMATION
    NextEntryOffset As Long
    FileIndex As Long
    CreationTime As LARGE_INTEGER
    LastAccessTime As LARGE_INTEGER
    LastWriteTime As LARGE_INTEGER
    ChangeTime As LARGE_INTEGER
    EndOfFile As LARGE_INTEGER
    AllocationSize As LARGE_INTEGER
    FileAttributes As Long
    FileNameLength As Long
    EaSize As Long
    ShortNameLength As Byte
    ShortName(23) As Byte
    FileName As Byte
    FileName1 As Integer '(519) As Byte
End Type

Private Const FileBothDirectoryInformation = 3
Private Const SYNCHRONIZE = &H100000
Private Const FILE_ANY_ACCESS = 0
Private Const FILE_LIST_DIRECTORY = 1
Private Const FILE_DIRECTORY_FILE = 1
Private Const FILE_SYNCHRONOUS_IO_NONALERT = &H20
Private Const FILE_OPEN_FOR_BACKUP_INTENT = &H4000
Private Const OBJ_CASE_INSENSITIVE = &H40

Private Declare Function NtQueryDirectoryFile Lib "ntdll.dll" (ByVal FileHandle As Long, _
                                ByVal hEvent As Long, _
                                ByVal ApcRoutine As Long, _
                                ByVal ApcContext As Long, _
                                ByRef IoStatusBlock As Any, _
                                FileInformation As Any, _
                                ByVal Length As Long, _
                                ByVal FileInformationClass As Long, _
                                ByVal ReturnSingleEntry As Long, _
                                FileName As Any, _
                                ByVal RestartScan As Long) As Long
Private Declare Function NtClose Lib "ntdll.dll" (ByVal ObjectHandle As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function NtOpenFile Lib "ntdll.dll" (FileHandle As Long, _
                                                    ByVal DesiredAccess As Long, _
                                                    ObjectAttributes As OBJECT_ATTRIBUTES, _
                                                    IoStatusBlock As IO_STATUS_BLOCK, _
                                                    ByVal ShareAccess As Long, _
                                                    ByVal OpenOptions As Long) As Long
                                                    
Private Declare Sub RtlInitUnicodeString Lib "ntdll.dll" (DestinationString As Any, ByVal SourceString As Long)
Private Declare Sub ZeroMemory Lib "ntdll.dll" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
                                
Private Function FindFirstFile(ByVal strDirectory As String, bytBuffer() As Byte) As Long
    Dim strFolder As String
    Dim obAttr As OBJECT_ATTRIBUTES
    Dim objIoStatus As IO_STATUS_BLOCK
    Dim ntStatus As Long
    Dim hFind As Long
    Dim strUnicode As UNICODE_STRING
    
    strFolder = "\??\"
    strFolder = strFolder & strDirectory
    RtlInitUnicodeString strUnicode, StrPtr(strFolder) 
    obAttr.Length = LenB(obAttr) 
    obAttr.Attributes = OBJ_CASE_INSENSITIVE
    obAttr.ObjectName = VarPtr(strUnicode) 
    obAttr.RootDirectory = 0
    obAttr.SecurityDescriptor = 0
    obAttr.SecurityQualityOfService = 0

    ntStatus = NtOpenFile(hFind, _
                        FILE_LIST_DIRECTORY Or SYNCHRONIZE Or FILE_ANY_ACCESS, _
                        obAttr, _
                        objIoStatus, _
                        3, _
                        FILE_DIRECTORY_FILE Or FILE_SYNCHRONOUS_IO_NONALERT Or FILE_OPEN_FOR_BACKUP_INTENT)
                        
    If ntStatus = 0 And hFind <> -1 Then

        ntStatus = NtQueryDirectoryFile(hFind, _
                                     0, _
                                     0, _
                                     0, _
                                     objIoStatus, _
                                     bytBuffer(0), _
                                     UBound(bytBuffer), _
                                     FileBothDirectoryInformation, _
                                     1, _
                                     ByVal 0&, _
                                     0)
        If ntStatus = 0 Then 
            FindFirstFile = hFind
        Else
            NtClose hFind
        End If
    End If
End Function

Private Function FindNextFile(ByVal hFind As Long, bytBuffer() As Byte) As Boolean
    Dim ntStatus As Long
    Dim objIoStatus As IO_STATUS_BLOCK

    ntStatus = NtQueryDirectoryFile(hFind, _
                                 0, _
                                 0, _
                                 0, _
                                 objIoStatus, _
                                 bytBuffer(0), _
                                 UBound(bytBuffer), _
                                 FileBothDirectoryInformation, _
                                 0, _
                                 ByVal 0&, _
                                 0)
    If ntStatus = 0 Then
        FindNextFile = True
    Else
        FindNextFile = False
    End If
End Function

Private Sub cmdEnum_Click()
    Dim pDir As FILE_BOTH_DIRECTORY_INFORMATION
    Dim hFind As Long
    Dim bytBuffer() As Byte
    Dim bytName() As Byte
    Dim strPath As String
    Dim strFileName As String * 520
    Dim dwFileNameOffset As Long
    Dim dwDirOffset As Long
    
    Me.lstFile.Clear
    ReDim bytBuffer(LenB(pDir) + 260 * 2 - 3)
    strPath = txtPath.Text
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    
    hFind = FindFirstFile(strPath, bytBuffer) '»ñÈ¡µÚÒ»¸öÎļþ/Ŀ¼¶ÔÏó
    CopyMemory pDir, bytBuffer(0), LenB(pDir) 
    ReDim bytName(pDir.FileNameLength - 1) 
    dwFileNameOffset = VarPtr(bytBuffer(&H5E)) 
    CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
    strFileName = strPath & CStr(bytName)
    Me.lstFile.AddItem strFileName
    Erase bytBuffer
    ReDim bytBuffer((LenB(pDir) + CLng(260 * 2 - 3)) * CLng(&H2000))
    If FindNextFile(hFind, bytBuffer) Then
        dwDirOffset = 0
        Do While 1
            ZeroMemory pDir, LenB(pDir)
            CopyMemory pDir, ByVal VarPtr(bytBuffer(dwDirOffset)), LenB(pDir) 
            Erase bytName
            ReDim bytName(pDir.FileNameLength - 1)
            dwFileNameOffset = dwDirOffset + &H5E
            dwFileNameOffset = VarPtr(bytBuffer(dwFileNameOffset))
            CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
            strFileName = strPath & CStr(bytName)
            Me.lstFile.AddItem strFileName 
            If pDir.NextEntryOffset = 0 Then Exit Do
            dwDirOffset = dwDirOffset + pDir.NextEntryOffset 
        Loop
    End If
    NtClose hFind
    Me.lblMsg.Caption = "Count: " & Me.lstFile.ListCount
End Sub

I'm just not sure how to limit it to directories only yet (apart from checking the .FileAttributes and excluding those after the fact.. pDir.FileAttributes And FILE_ATTRIBUTE_DIRECTORY). It's also not recursive so you'd have to implement that no matter what, the API can't do that on its own.