Directory Tree - Generates a list of subdirectories.

**fafalone** · Jul 30th, 2016, 11:20 PM

I noticed a similar problem while using FILE_BOTH_DIR_INFORMATION... it didn't list folders, and it didn't list the last 4 files. But after switching to FILE_DIRECTORY_INFORMATION it showed everything in every remote folder I tried. Did you adjust the offsets in both places?

Just in case you're having a permissions issue, I'd change FILE_ANY_ACCESS to FILE_READ_ACCESS (&H1) so you're not requesting write access.

Try using the same changes I'm using; drop in the following to replace everything in frmMain in the sample project:

Code:

Option Explicit
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
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 '8 bytes
    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 '//64
    EaSize As Long
    ShortNameLength As Byte
    ShortName(23) As Byte
    FileName As Byte
    FileName1 As Integer '(519) As Byte; OFFSET=&H5E (94 bytes, this is the 95th)
End Type
Private Type FILE_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
  FileName1 As Integer 'OFFSET=&H40 (64)
End Type
Private Type FILE_FULL_DIR_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 '//64 bytes in standard members
  EaSize As Long
  FileName1 As Integer 'OFFSET=&H48
End Type
Private Type FILE_ID_BOTH_DIR_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 '//64 bytes in standard members
  EaSize As Long
  ShortNameLength As Byte
  ShortName(23) As Byte
  FileId As LARGE_INTEGER
  FId(2) As Byte 'Padding
  FileName1 As Integer '//OFFSET=104 &H68
End Type
Private Type FILE_ID_FULL_DIR_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 '//64 bytes in standard members
  EaSize As Long
  FileId As LARGE_INTEGER
  FileName1 As Integer '//OFFSET=76 &H4C
            
End Type
Private Type FILE_NAMES_INFORMATION
  NextEntryOffset As Long
  FileIndex As Long
  FileNameLength As Long
  FileName1 As Integer '//OFFSET=12  &HC
End Type
'Only the uncommented values can be used with NtQueryDirectoryFile
Private Enum FILE_INFORMATION_CLASS
        FileDirectoryInformation = 1
        FileFullDirectoryInformation = 2
        FileBothDirectoryInformation = 3
        FileNamesInformation = 12
        FileObjectIdInformation = 29
        FileReparsePointInformation = 33
        FileIdBothDirectoryInformation = 37
        FileIdFullDirectoryInformation = 38
End Enum
Private Const SYNCHRONIZE = &H100000
Private Const FILE_ANY_ACCESS = 0
Private Const FILE_READ_ACCESS = 1
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 Const FILE_OPEN = 1
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1&
Private Const OPEN_ALWAYS As Long = 4&
Private Const OPEN_EXISTING As Long = 3&
Private Const CREATE_ALWAYS As Long = 2&
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_END As Long = 2&
Private Const GENERIC_ALL               As Long = &H10000000
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&

Private Declare Function RtlDosPathNameToNtPathName_U Lib "ntdll" (ByVal DosFileName As Long, NtFileName As UNICODE_STRING, FilePart As Long, RelativeName As Any) As Boolean

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" ( _
    ByVal lpFileName As Long, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long

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 FILE_INFORMATION_CLASS, _
                                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 Function NtCreateFile Lib "ntdll.dll" (FileHandle As Long, _
                                                    ByVal DesiredAccess As Long, _
                                                    ObjectAttributes As OBJECT_ATTRIBUTES, _
                                                    IoStatusBlock As IO_STATUS_BLOCK, _
                                                    AllocationSize As Any, _
                                                    ByVal FileAttributes As Long, _
                                                    ByVal ShareAccess As Long, _
                                                    ByVal CreateDisposition As Long, _
                                                    ByVal CreateOptions As Long, _
                                                    ByVal EaBuffer As Any, _
                                                    ByVal EaLength As Long) As Long
Private Declare Sub RtlInitUnicodeString Lib "ntdll.dll" (DestinationString As Any, ByVal SourceString As Long)
Private Declare Sub RtlFreeUnicodeString Lib "ntdll.dll" (UnicodeString As UNICODE_STRING)
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
    Dim fp As Long, rn As Long
    strFolder = "\??\"
    strFolder = strFolder & strDirectory
    RtlDosPathNameToNtPathName_U StrPtr(strFolder), strUnicode, fp, rn
    
'    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 = NtCreateFile(hFind, FILE_LIST_DIRECTORY Or SYNCHRONIZE Or FILE_READ_ACCESS, _
'                            obAttr, objIoStatus, ByVal 0&, 0&, FILE_SHARE_READ, FILE_OPEN, _
'                            FILE_DIRECTORY_FILE Or FILE_SYNCHRONOUS_IO_NONALERT, ByVal 0&, 0&)
    NTSTATUS = NtOpenFile(hFind, _
                        FILE_LIST_DIRECTORY Or SYNCHRONIZE Or FILE_READ_ACCESS, _
                        obAttr, _
                        objIoStatus, _
                        3, _
                        FILE_DIRECTORY_FILE Or FILE_SYNCHRONOUS_IO_NONALERT) ' Or FILE_OPEN_FOR_BACKUP_INTENT)
     Debug.Print "hFind=" & hFind & ",ntStatus=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)
        Debug.Print "iostatus=0x" & Hex$(objIoStatus.Status) & ",iobytes=" & objIoStatus.uInformation
    If NTSTATUS = 0 And hFind <> -1 Then
        NTSTATUS = NtQueryDirectoryFile(hFind, _
                                     0, _
                                     0, _
                                     0, _
                                     objIoStatus, _
                                     bytBuffer(0), _
                                     UBound(bytBuffer) + 1, _
                                     FileDirectoryInformation, _
                                     1, _
                                     ByVal 0&, _
                                     0)
        If NTSTATUS = 0 Then
            FindFirstFile = hFind
        Else
            Debug.Print "Error2, ntStatus=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)
            NtClose hFind
        End If
    Else
                Debug.Print "Error, ntStatus=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)

    End If
    RtlFreeUnicodeString strUnicode
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) + 1, _
                                 FileDirectoryInformation, _
                                 0, _
                                 ByVal 0&, _
                                 0)
    If NTSTATUS = 0 Then
        FindNextFile = True
    Else
        Debug.Print "FindNextFile hFind=" & hFind & ",err=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)
        Debug.Print "iostatus=0x" & Hex$(objIoStatus.Status) & ",iobytes=" & objIoStatus.uInformation
        FindNextFile = False
    End If
End Function

Private Sub cmdEnum_Click()
    Dim strPath As String
strPath = txtPath.Text
    Me.lstFile.Clear
    DoSearch strPath
    Me.lblMsg.Caption = "Count=" & Me.lstFile.ListCount
End Sub

Private Sub DoSearch(strPath As String)
    Debug.Print "DoSearch(" & strPath & ")"
    Dim pDir As FILE_DIRECTORY_INFORMATION
    Dim hFind As Long
    Dim bytBuffer() As Byte
    Dim bytName() As Byte
    Dim strFileName As String * 520
    Dim dwFileNameOffset As Long
    Dim dwDirOffset As Long
    Dim sTrimmed As String
    Dim i As Long
    ReDim bytBuffer(LenB(pDir) + 260 * 2 - 3)
    
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    hFind = FindFirstFile(strPath, bytBuffer)
    If hFind = -1 Then
        Debug.Print "hFind=-1, exiting"
        Exit Sub
    End If
    CopyMemory pDir, bytBuffer(0), LenB(pDir)
    Debug.Print "initlen=" & pDir.FileNameLength
    ReDim bytName(pDir.FileNameLength - 1)
    dwFileNameOffset = VarPtr(bytBuffer(&H40))
    CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
    strFileName = strPath & CStr(bytName)
    
    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 + &H40
            dwFileNameOffset = VarPtr(bytBuffer(dwFileNameOffset))
            CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
            strFileName = strPath & CStr(bytName)
                sTrimmed = Left$(strFileName, Len(strPath) + (pDir.FileNameLength / 2))
                If (sTrimmed <> (strPath & ".")) And (sTrimmed <> (strPath & "..")) Then
                    i = i + 1
                    Me.lstFile.AddItem CStr(i) & ": " & sTrimmed
                    Debug.Print "file=" & sTrimmed
                    If pDir.FileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
                            DoSearch sTrimmed
                    End If
                End If
            If pDir.NextEntryOffset = 0 Then Exit Do
            dwDirOffset = dwDirOffset + pDir.NextEntryOffset
            
        Loop
    End If
    NtClose hFind

End Sub

That will add all files and folders, recursively, to the list. It will also number things so you can track down what's not showing up if you still have that problem.

One other thing to consider... is the performance gain from this function so huge it's a significant factor in the latency of listing the contents of a remote system? Something to measure.

Thread: Directory Tree - Generates a list of subdirectories.

Thread Tools

Display

Threaded View

Re: Directory Tree - Generates a list of subdirectories.

Tags for this Thread

Posting Permissions