Computer Science Canada

Directory Reading
Author:  srbman [ Sun Apr 30, 2006 11:11 am ]
Post subject:  Directory Reading
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
Author:  GlobeTrotter [ Sun Apr 30, 2006 11:24 am ]
Post subject: 
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.
Author:  srbman [ Sun Apr 30, 2006 11:57 am ]
Post subject: 
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)
Author:  GlobeTrotter [ Sun Apr 30, 2006 2:05 pm ]
Post subject: 
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.
Author:  srbman [ Sun Apr 30, 2006 2:47 pm ]
Post subject: 
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
Author:  GlobeTrotter [ Sun Apr 30, 2006 4:52 pm ]
Post subject: 
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
Author:  srbman [ Mon May 01, 2006 7:09 pm ]
Post subject: 
thanx ill try working on it next weekend when i have more time.
Author:  Andy [ Tue May 02, 2006 12:27 pm ]
Post subject: 
use system call "dir > blah.txt" then parse it Laughing

:


You can syndicate this boards posts using the file backend.php or view the topic map using sitemap.php.

Terms of Use | Privacy Policy