Show Hidden Directories in DirListBox

Option Explicit
'
'    Usage:
'    From the Change event of your dir box call
'        ShowHiddenDirectories Dir1 'Dir1 or whatever you've named it
'    Note that you should either provide the user the choice to show
'    hidden files or check the registry HKEY_CURRENT_USER\Software\
'    Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden for their preference
'_______________________________________
'   APIs for show hidden files
'_______________________________________
Private Const MAX_PATH = 260
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
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
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const LB_GETCOUNT = &H18B
Private Const LB_INSERTSTRING = &H181
Private Const LB_ERR = (-1)
'private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
'private Const FILE_ATTRIBUTE_ARCHIVE = &H20
'private Const FILE_ATTRIBUTE_NORMAL = &H80
'private Const FILE_ATTRIBUTE_TEMPORARY = &H100
'private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByVal lParam As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
'* bShowSystem - shows directories with both the hidden and system attributes set
'* non-hidden system directories are already shown and are not affected by this
'* you probably shouldn't show hidden system folders (such as the
'  recycle bin and it's raw files)
Private Sub ShowHiddenDirectories(DirCtrl As DirListBox, Optional bShowSystem As Boolean)
    Dim res As Long
    Dim sF As String, sDirPath
    Dim FData As WIN32_FIND_DATA
    Dim fHand As Long, i As Long
    Dim level As Long
    Dim StillOK As Long
    Const HIDDEN_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_HIDDEN
'     Const LBS_SORT = &H2&
    sDirPath = DirCtrl.Path
    'append trailing slash
    If Right$(sDirPath, 1) <> "\" Then sDirPath = sDirPath & "\"
    
    'get dir path level (i.e. c:\windows\system = 3)
    'LB_GETCOUNT counts all items in dirbox while
    'DirCtrl.ListCount gives only subdirectories
        '    VB method
        '    i = -1
        '    Do While Len(DirCtrl.List(i))
        '        i = i - 1
        '    Loop
        '    level = Abs(i) - 1
    'api
    res = SendMessage(DirCtrl.hwnd, LB_GETCOUNT, 0, 0)
    If res = LB_ERR Then Exit Sub
    level = res - DirCtrl.ListCount
    
    'Find hidden directories
    fHand = FindFirstFile(sDirPath & "*", FData)
    StillOK = fHand
    Do While StillOK > 0
        'check if file is a folder and hidden
        If (FData.dwFileAttributes And HIDDEN_DIRECTORY) >= HIDDEN_DIRECTORY Then
           'continue if we don't care if folder has system attribute
           'or if the folder doesn't have system attribute
           If bShowSystem Or ((FData.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) = 0) Then
            sF = CutRightAt(FData.cFileName)
            If sF <> "." And sF <> ".." Then
                'add the hidden folder to the dirbox
                
                'it is ordered automatically but incorrectly with LB_ADDSTRING
                'i.e. a hidden folder called A1 would be placed before C:\
'                res = SendMessageString(DirCtrl.hwnd, LB_ADDSTRING, 0, sF)
                
                'move backwards through dirbox and insert alphabetically
                'you could of course use a binary search but for any
                'Win9X system I've seen this would be overkill
                i = DirCtrl.ListCount
                Do
                    If i > 0 Then
                        'compare against part of DirBox's item that is foldername w/o path
                        res = StrComp(sF, Right(DirCtrl.List(i - 1), Len(DirCtrl.List(i - 1)) - Len(sDirPath)), vbTextCompare)
                        If res >= 0 Then 'found insertion point, now add folder
                            'don't add folder if the 2 strings are the same
                            'could occur if you invoked this sub a 2nd time w/o cd-ing
                            If res Then res = SendMessageString(DirCtrl.hwnd, LB_INSERTSTRING, i + level, sF)
                            Exit Do
                        'else keep looking for insertion point
                        End If
                    Else 'folder is first alphabetically
                        If i = 0 Then res = SendMessageString(DirCtrl.hwnd, LB_INSERTSTRING, i + level, sF)
                    End If
                    i = i - 1
                Loop While i >= 0
            End If 'not . or ..
           End If 'system
        End If 'hidden
        StillOK = FindNextFile(fHand, FData)
    Loop
    fHand = FindClose(fHand)
End Sub
'   typical TrimNull function with option to trim at any character
Private Function CutRightAt(NormString As String, Optional ascii As Long = 0) As String
    Dim i As Long
    i = InStr(1, NormString, Chr(ascii), vbBinaryCompare)
    If i Then
        CutRightAt = Left(NormString, i - 1)
    Else
        CutRightAt = NormString
    End If
End Function
'_______________________________________
'   the Form Code - the code above
'   could be moved to a bas module
'   with the obvious change to Public
'   of sub ShowHiddenDirectories
'_______________________________________
Private Sub Dir1_Change()
    ShowHiddenDirectories Dir1, Check1.Value = vbChecked
    File1.Path = Dir1
End Sub
Private Sub Check1_Click()
    If Check1.Value = vbUnchecked Then Dir1.Refresh 'return to non-hidden non-system view
    ShowHiddenDirectories Dir1, Check1.Value = vbChecked
End Sub
'    © 9/18/2000
'    This code is by Arthur Marks aamarks@ambytes.com.
'
'    You may use this code as you wish in your own projects. You may
'    distribute this code as long as you do not charge for it and you
'    include this information with it. (I would appreciate if you e-mail
'    me to let me know where you are posting it.) For ease of distribution
'    all code has been placed in a form module.
'
'    Use at your own risk, etc.
'
'    Functional Description:
'    Searches a DirListBox's Path for hidden files.
'    It then adds each hidden folder to the Dirbox at the appropriate
'    position. VB/Windows handles the added items without any further
'    coding.
'
'    Thanks to the contributors in the VB API newsgroups for supplying
'    me with most of my knowledge on the API.