by Dragon (1 Submission)
Category: Windows System Services
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Sun 3rd October 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Function that lists all the dirs beneath a spceified root folder (or drive).
VBcoders
'***********************************************************
'* 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
No comments have been posted about Function that lists all the dirs beneath a spceified root folder (or drive).. Why not be the first to post a comment about Function that lists all the dirs beneath a spceified root folder (or drive)..
