Directory Reading

[srbman]

I was wondering if anyone knew a way to read all the file names in a given directory and copy them into a text file. I would prefer the code in any of the following: Flash AS1.x or 2.x, Visual Basic 6.x, or Turing if possible. Thanx

[GlobeTrotter]

Here's a module I wrote in vb6 (with the help of some tutorials on some Win32 functions) that takes in a directory as an arguments, as well as whether or not it should check sub-folders as well. If it should check sub-folders, it recursively searches those folders for files or folders. It is not perfect, unfortunately, and probably could be optimized quite a deal. But still, it works for me.

This is the primary module:

code:

Option Explicit Public Const MAX_PATH = 260 Private Const ERROR_NO_MORE_FILES = 18 Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_ATTRIBUTE_HIDDEN = &H2 Private Const FILE_ATTRIBUTE_SYSTEM = &H4 Private Const FILE_ATTRIBUTE_TEMPORARY = &H100 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 FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _     (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Function StripTerminator(ByVal strString As String) As String     Dim intZeroPos As Integer     intZeroPos = InStr(strString, Chr$(0))     If intZeroPos > 0 Then         StripTerminator = Left$(strString, intZeroPos - 1)     Else         StripTerminator = strString     End If End Function Private Function ListFilesNoDepth(ByVal sStartDir As String) As String()     Dim strFileArray() As String     Dim lpFindFileData As WIN32_FIND_DATA, lFileHdl  As Long     Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex  As Integer     Dim strPath As String         On Error Resume Next         '// add trailing \ to start directory if required     If Right$(sStartDir, 1) <> "\" Then sStartDir = sStartDir & "\"     sStartDir = sStartDir & "*.*"         '// get a file handle     lFileHdl = FindFirstFile(sStartDir, lpFindFileData)         If lFileHdl <> -1 Then         Do Until lRet = ERROR_NO_MORE_FILES             strPath = Left$(sStartDir, Len(sStartDir) - 4) & "\"             '// if it is a file             If (lpFindFileData.dwFileAttributes And vbDirectory) <> FILE_ATTRIBUTE_DIRECTORY Then                 sTemp = StrConv(Left$(sStartDir, Len(sStartDir) - 3) & StripTerminator(lpFindFileData.cFileName), vbLowerCase)                 Call strArrayAdd(strFileArray, sTemp)             End If             '// based on the file handle iterate through all files and dirs             lRet = FindNextFile(lFileHdl, lpFindFileData)             If lRet = 0 Then Exit Do         Loop     End If     '// close the file handle     lRet = FindClose(lFileHdl)         ListFilesNoDepth = strFileArray End Function Private Function ListDirsNoDepth(ByVal sStartDir As String) As String()     Dim strFolderArray() As String     Dim lpFindFileData As WIN32_FIND_DATA, lFileHdl  As Long     Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex  As Integer     Dim strPath As String         On Error Resume Next         '// add trailing \ to start directory if required     If Right$(sStartDir, 1) <> "\" Then sStartDir = sStartDir & "\"     sStartDir = sStartDir & "*.*"         '// get a file handle     lFileHdl = FindFirstFile(sStartDir, lpFindFileData)         If lFileHdl <> -1 Then         Do Until lRet = ERROR_NO_MORE_FILES             strPath = Left$(sStartDir, Len(sStartDir) - 4) & "\"             '// if it is a directory             If (lpFindFileData.dwFileAttributes And vbDirectory) = FILE_ATTRIBUTE_DIRECTORY Then                 'Strip off null chars and format the string                 sTemp = StrConv(Left$(sStartDir, Len(sStartDir) - 3) & StripTerminator(lpFindFileData.cFileName), vbLowerCase)                 ' make sure it is not a reference                 If InStr(sTemp, ".") = 0 Then                     'add it to the tree view. Store its path as its Key                     Call strArrayAdd(strFolderArray, sTemp)                 End If             End If             '// based on the file handle iterate through all files and dirs             lRet = FindNextFile(lFileHdl, lpFindFileData)             If lRet = 0 Then Exit Do         Loop     End If     '// close the file handle     lRet = FindClose(lFileHdl)         ListDirsNoDepth = strFolderArray End Function Public Function ListFiles(ByVal strStartDir As String, boDepth As Boolean) As String()     Dim strFiles() As String     Dim strDirs() As String     Dim lCount As Long         If Not boDepth Then         strFiles = ListFilesNoDepth(strStartDir)     Else         strDirs = ListDirsNoDepth(strStartDir)         If strFixedUBound(strDirs) = -1 Then             strFiles = ListFilesNoDepth(strStartDir)         Else             For lCount = 0 To strFixedUBound(strDirs)                 Call strArrayAddArray(strFiles, ListFilesNoDepth(strDirs(lCount)))                 Call strArrayAddArray(strFiles, ListFiles(strDirs(lCount), boDepth))             Next lCount         End If     End If         ListFiles = strFiles End Function Public Function ListDirs(ByVal strStartDir As String, boDepth As Boolean) As String()     Dim strDirs() As String     Dim lCount As Long         If Not boDepth Then         strDirs = ListDirsNoDepth(strStartDir)     Else         strDirs = ListDirsNoDepth(strStartDir)         For lCount = 0 To strFixedUBound(strDirs)             Call strArrayAddArray(strDirs, ListDirs(strDirs(lCount), boDepth))         Next lCount     End If         ListDirs = strDirs End Function

You may also need these secondary functions/procedures

code:

Public Function strArrayRemoveDupes(strArray() As String) As String()     Dim ArrResult() As String     Dim lCount1 As Long     Dim lCount2 As Long         Dim tempBool As Boolean         For lCount1 = 0 To strFixedUBound(strArray)         tempBool = True         For lCount2 = lCount1 To strFixedUBound(strArray)             If lCount1 <> lCount2 And strArray(lCount1) = strArray(lCount2) Then                 tempBool = False             End If         Next lCount2                 If tempBool Then             Call strArrayAdd(ArrResult, strArray(lCount1))         End If     Next lCount1         strArrayRemoveDupes = ArrResult End Function Public Sub WriteFile(LineArray() As String, strFileName As String)     Dim FileNum As Integer     Dim lCount As Long         FileNum = FreeFile     Open strFileName For Output As FileNum         If Not isStringArrayEmpty(LineArray) Then         For lCount = 0 To UBound(LineArray)             Print #FileNum, LineArray(lCount)         Next lCount     End If     Close #FileNum End Sub

To call it, you would go like this:

code:

Call WriteFile(strArrayRemoveDupes(ListFiles("C:/SEARCH_DIRECTORY",False)),"C:/OUTPUT_FILE.TXT")

When I talked about it not being perfect, I was primarily referring to the need to use the RemoveDupes function. For some reason, which I can't figure out, my ListFiles function will sometimes output duplicate filenames. But I employed a quick fix, and it shouldn't do that anymore.

[srbman]

your code works until it gets to strFixedUBound and then it says "sub or fucntion not defined" i put the module code in "module1" the secondary procedures in "form1" called everything in a button on form1 do i need to add or change anything to make it work? (i changed the target directory to a directory on my computer)

[GlobeTrotter]

Oh, my bad. Also include these small functions:

code:

Public Function isStringArrayEmpty(StringArray() As String) As Boolean     Dim lTemp As Long     On Error Resume Next     lTemp = UBound(StringArray)     isStringArrayEmpty = (Err.Number <> 0) End Function Public Function strFixedUBound(StringArray() As String) As Long     If isStringArrayEmpty(StringArray) Then         strFixedUBound = -1     Else         strFixedUBound = UBound(StringArray)     End If End Function

strFixedUBound just returns the upper bound of an array (almost identical to UBound) except it returns -1 if the array is empty.

You also will probably need these functions too:

code:

Public Sub strArrayAdd(ByRef strArray() As String, strAdd As String)     If isStringArrayEmpty(strArray) Then         ReDim strArray(0)         strArray(0) = strAdd     Else         ReDim Preserve strArray(UBound(strArray) + 1)         strArray(UBound(strArray)) = strAdd     End If End Sub Public Sub strArrayAddArray(ByRef strArray() As String, strAddArray() As String)     Dim lCount As Long     If isStringArrayEmpty(strArray) Then         strArray = strAddArray     Else         For lCount = 0 To strFixedUBound(strAddArray)             ReDim Preserve strArray(strFixedUBound(strArray) + 1)             strArray(UBound(strArray)) = strAddArray(lCount)         Next lCount     End If End Sub

It should work now, sorry. Let me know if it works.

[srbman]

thanx it works, is there a way to get rid of the album art jpegs that it gives in a music folder? (for example albumart_{f52fbda5-47e8-4d41-aa76-9bd0b3b11ebb}_large.jpg )

thanx again

[GlobeTrotter]

You could always write a function that loops through each file and checks if the filetype is ".mp3", and if the filetype isn't mp3, remove it. It would not be at all difficult. Here are some functions I've already made that may be useful for this:

code:

Public Function ExtractFileType(ByVal strPath As String) As String     Dim strResult As String     Dim lDotLocation As Long         If Len(strPath) > 0 Then         lDotLocation = InStrRev(strPath, ".")         If lDotLocation > 0 Then             strResult = Mid(strPath, lDotLocation + 1)         End If     End If         ExtractFileType = strResult End Function Public Function ExtractFileName(ByVal strPath As String) As String     Dim strResult As String     Dim lDotLocation As Long     Dim lSlashLocation As Long         If Len(strPath) > 0 Then         lDotLocation = InStrRev(strPath, ".")         lSlashLocation = InStrRev(strPath, "\")         If lDotLocation > 0 Then             strResult = Mid(strPath, lSlashLocation + 1, lDotLocation - lSlashLocation - 1)         Else             strResult = Mid(strPath, lSlashLocation + 1)         End If     End If         ExtractFileName = strResult End Function Public Function ExtractFolder(ByVal strPath As String) As String     Dim strResult As String     Dim lSlashLocation As Long     Dim lDotLocation As Long         strResult = ReplaceInString(strPath, "/", "\")     lSlashLocation = InStrRev(strResult, "\")     lDotLocation = InStrRev(strResult, ".")         If lSlashLocation > 0 Then         If lDotLocation > 0 Then             strResult = Left$(strResult, lSlashLocation)         End If                 If Right$(strResult, 1) = "\" Then             strResult = Left$(strResult, Len(strResult) - 1)         End If                 lSlashLocation = InStrRev(strResult, "\")                 strResult = Mid(strResult, lSlashLocation + 1)     End If         ExtractFolder = strResult End Function

[srbman]

thanx ill try working on it next weekend when i have more time.

[Andy]

use system call "dir > blah.txt" then parse it