• Home
 · 
• Windows System Services
 · 
• Function that lists all the dirs beneath a spceified root folder (or drive).

Function that lists all the dirs beneath a spceified root folder (or drive).

Function that lists all the dirs beneath a spceified root folder (or drive).

Rate Function that lists all the dirs beneath a spceified root folder (or drive).

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    
   '***********************************************************
   '* Author: Dragon <[email protected]>            *
   '*         http://personal.inet.fi/cool/dragon/vb/         *
   '*                                                         *
   '* Last updated: August 14, 1998                           *
   '*                                                         *
   '* This recursive routine scans a specified folder (or     *
   '* drive) for dirs and retuns a string containing all the  *
   '* dirs, properly indented. Note: This function does NOT   *
   '* sort the list in any way                                *
   '*                                                         *
   '* This function has the following arguments:              *
   '*                                                         *
   '*   strRootFolder  =  the directory from which the search *
   '*                     starts. The search will put this dir*
   '*                     as the top dir and only list dirs   *
   '*                     beneath it.                         *
   '*                                                         *
   '*   strIndent  =  the string to use for indentation of    *
   '*                 subdirs, for example "---"              *
   '*                                                         *
   '*   strLevel  =  only for internal usage, don't use this  *
   '*                                                         *
   '* Example usage:                                          *
   '*   strDirList = ListDirs("C:\", "---")
   '*                                                         *
   '***********************************************************

    Dim lngSearchHandle As Long
    Dim udtFindData As WIN32_FIND_DATA
    Dim strTemp As String, lngRet As Long
    Dim strList As String
    
    'Check that folder name ends with "\"
    If Right$(strRootFolder, 1) <> "\" Then strRootFolder = strRootFolder & "\"
    
    'Add Rootfolder to dir list
    strList = AddDir(strList, strRootFolder, lngLevel, strIndent)
    
    'Find first file/folder in current folder
    lngSearchHandle = FindFirstFile(strRootFolder & "*", udtFindData)
    
    'Check that we received a valid handle
    If lngSearchHandle = INVALID_HANDLE_VALUE Then Exit Function
    
    lngRet = 1
    
    Do While lngRet <> 0
        
        'Trim nulls from filename
        strTemp = TrimNulls(udtFindData.cFileName)
        
        If (udtFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            'It's a dir - make sure it isn't . or .. dirs
            If strTemp <> "." And strTemp <> ".." Then
                'It's a normal dir: let's dive straight
                'into it...
                strList = strList & ListDirs(strRootFolder & strTemp, strIndent, lngLevel + 1)
            End If
        End If
        
        'Get next file/folder
        lngRet = FindNextFile(lngSearchHandle, udtFindData)
        
    Loop
    
    'Close find handle
    Call FindClose(lngSearchHandle)
    
    ListDirs = strList
    
End Function

Private Function AddDir(strData As String, strDir As String, lngLevel As Long, strIndent As String)

    Dim strTemp As String, l As Long
    
    'Create indent string
    For l = 1 To lngLevel
        strTemp = strTemp & strIndent
    Next l

    'Add indentation and dir
    AddDir = strData & strTemp & strDir & vbCrLf$
    
End Function

Public Function TrimNulls(strString As String) As String
   
   Dim l As Long
   
   l = InStr(1, strString, Chr(0))
   
   If l = 1 Then
      TrimNulls = ""
   ElseIf l > 0 Then
      TrimNulls = Left$(strString, l - 1)
   Else
      TrimNulls = strString
   End If
   
End Function