What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleSelect random files from a set of directories to build a MP3 player mix
DescriptionThis example shows how to select random files from a set of directories to build a MP3 player mix in Visual Basic 6.
Keywordsmp3, mix, random, random files, browse, SaveSetting, GetSetting, DeleteSetting
CategoriesFiles and Directories, Software Engineering, Multimedia
My MP3 player only has 164 MB of memory so it cannot hold all of my music at once. This application randomly picks files from a set of directories and copies them into a new mix directory. My MP3 player looks like a directory in the file system so I can copy files directly onto it until it is full.

This application demonstrates several useful techniques including:

  • Loading and saving settings when the application starts and stops.
  • Tracking multiple selected directories.
  • Managing ListBox choices.
  • Quickly listing the files in a directory with API functions.
  • Converting long file names to short file names.
  • Letting the user browse to select a directory.
  • Randomizing an array.
  • Generating a list of random files picked from the selected directories.
  • Copying files.

When the program starts, it calls its LoadSettings routine. That routine uses GetSetting to loads saved settings. It loads source directory names and their selected state by looping through the setting values Source0, Source1, ... and Selected0, Selected1, ...

Private Sub LoadSettings()
Dim i As Integer
Dim txt As String

    txtDestination.Text = GetSetting(App.ProductName, _
        "Settings", "DestinationDirectory", CurDir)
    txtNumFiles.Text = GetSetting(App.ProductName, _
        "Settings", "NumFiles", "1")

    For i = 0 To 100
        txt = GetSetting(App.ProductName, "Settings", _
            "Source" & Format$(i), "")
        If Len(txt) < 1 Then Exit For
        lstSources.AddItem txt
        lstSources.Selected(i) = _
            CBool(GetSetting(App.ProductName, "Settings", _
            "Selected" & Format$(i), "False"))
    Next i
End Sub
When the form is closing, it calls the SaveSettings routine. This routine uses DeleteSetting to remove any previously saved settings. This clears out the source data and is necessary if the new source list is smaller than the previous one.

Next the program uses SaveSetting to save the current settings.

Private Sub SaveSettings()
Dim i As Integer

    On Error Resume Next
    DeleteSetting App.ProductName
    On Error GoTo 0

    SaveSetting App.ProductName, "Settings", _
        "DestinationDirectory", txtDestination.Text
    SaveSetting App.ProductName, "Settings", "NumFiles", _

    For i = 0 To lstSources.ListCount - 1
        SaveSetting App.ProductName, "Settings", "Source" & _
            Format$(i), lstSources.List(i)
        SaveSetting App.ProductName, "Settings", "Selected" _
            & Format$(i), lstSources.Selected(i)
    Next i
End Sub
When the user clicks the Add button, the program displays a dialog that lets the user select a new source directory. The dlgPickFolder form lets the user enter or select the directory. The main form checks the dialog's txtDir text box to see if the user made a selection. If txtDir is not blank, then the program uses ChDir to try to move to that directory. If it succeeds, the program adds the directory to the source list.
Private Sub cmdAdd_Click()
    dlgPickFolder.txtDir.Text = CurDir
    dlgPickFolder.Show vbModal
    If Len(dlgPickFolder.txtDir.Text) > 0 Then
        On Error Resume Next
        ChDir dlgPickFolder.txtDir.Text
        If Err.Number <> 0 Then
            MsgBox "Error moving to directory '" & _
                dlgPickFolder.txtDir.Text & "'", _
                vbExclamation Or vbOKOnly, _
                "Directory Error"
            lstSources.AddItem dlgPickFolder.txtDir.Text
        End If
        On Error GoTo 0
    End If
    Unload dlgPickFolder
End Sub
When the user clicks the Remove button, the program confirms that the user wants to remove the selected source directories from the list and then removes them.
Private Sub cmdRemove_Click()
Dim i As Integer

    If lstSources.ListCount < 1 Then
        MsgBox "No sources selected to delete", _
            vbInformation Or vbOKOnly, "No Sources Selected"
    ElseIf MsgBox("Delete selected sources?", vbQuestion Or _
        vbYesNo, "Delete Sources?") = vbYes Then
        For i = lstSources.ListCount - 1 To 0 Step -1
            If lstSources.Selected(i) Then
                lstSources.RemoveItem i
            End If
        Next i
    End If
End Sub
When the user clicks the Browse button, the program displays a folder browse dialog to let the user select the destination directory. Function BrowseForDirectory displays a standard folder browser and returns the selected directory.
' Let the user browse for a directory. Return the
' selected directory. Return an empty string if
' the user cancels.
Public Function BrowseForDirectory(ByVal hwnd As Long) As _
Dim browse_info As BrowseInfo
Dim item As Long
Dim dir_name As String
   browse_info.hWndOwner = hwnd
   browse_info.pidlRoot = 0
   browse_info.sDisplayName = Space$(260)
   browse_info.sTitle = "Select Directory"
   browse_info.ulFlags = 1 ' Return directory name.
   browse_info.lpfn = 0
   browse_info.lParam = 0
   browse_info.iImage = 0
   item = SHBrowseForFolder(browse_info)
   If item Then
       dir_name = Space$(260)
       If SHGetPathFromIDList(item, dir_name) Then
           BrowseForDirectory = Left(dir_name, _
               InStr(dir_name, Chr$(0)) - 1)
           BrowseForDirectory = ""
       End If
   End If
End Function
When the user clicks the Load Files button, the program makes collections to hold the names and directories of the files in the selected source directories. For each currently selected source, the program calls subroutine ListFiles to get the file and directory names.

It then makes an array containing the indexes of the files and uss subroutine RandomizeArray to randomize the indexes. Next it uses the indexes to access the files in random order and copies them to the destination directory.

Private Sub cmdLoadFiles_Click()
Dim directories As Collection
Dim file_names As Collection
Dim i As Integer
Dim num_files As Integer
Dim indexes() As Integer
Dim dest_dir As String
Dim files_to_copy As Integer
Dim files_copied As Integer
Dim from_name As String
Dim to_name As String

    ' Make a list of all of the files.
    Set directories = New Collection
    Set file_names = New Collection
    For i = 0 To lstSources.ListCount - 1
        If lstSources.Selected(i) Then
            ListFiles lstSources.List(i), directories, _
        End If
    Next i

    ' See how many files we found.
    num_files = file_names.Count
    If num_files < 1 Then
        MsgBox "No files found", vbExclamation Or vbOKOnly, _
            "No Files"
        Exit Sub
    End If

    ' Make the indexes array.
    ReDim indexes(1 To num_files)
    For i = 1 To num_files
        indexes(i) = i
    Next i

    ' Randomize the indexes array.
    RandomizeArray indexes

    ' Grab the first files.
    files_to_copy = CInt(txtNumFiles.Text)
    If files_to_copy > num_files Then files_to_copy = _

    ' Start copying files.
    dest_dir = txtDestination.Text
    files_copied = 0
    On Error Resume Next
    For i = 1 To files_to_copy
        from_name = directories(indexes(i)) & "\" & _
        to_name = dest_dir & "\" & file_names(indexes(i))
        FileCopy from_name, to_name
        If Err.Number <> 0 Then
            MsgBox "Error copying file '" & from_name & _
                "' to file '" & to_name & "'" & vbCrLf & _
                Err.Description, _
                vbExclamation Or vbOKOnly, _
                "Copy Error"
            Exit For
        End If
        files_copied = files_copied + 1
'        Debug.Print i & ": FileCopy """ & _
'            directories(indexes(i)) & "\" &
' file_names(indexes(i)) & """, """ & _
'            dest_dir & "\" & file_names(indexes(i)) & """"
    Next i
    On Error GoTo 0

    MsgBox "Copied " & files_copied & " files", _
        vbInformation Or vbOKOnly, "Done"
End Sub
Subroutine ListFiles uses API functions to search a directory for files that match the pattern *.mp3. It adds the file names and their directory to the directories and file_names collections.

Note that the routine uses the ShortFileName function to convert the file names into the short format required by the file searching API functions.

' List all music files in the directory.
Public Sub ListFiles(ByVal start_dir As String, ByVal _
    directories As Collection, ByVal file_names As _
Dim fname As String
Dim search_handle As Long
Dim file_data As WIN32_FIND_DATA

    start_dir = ShortFileName(start_dir)

    ' Get the first file.
    search_handle = FindFirstFile(start_dir & "\*.mp3", _
    If search_handle <> INVALID_HANDLE_VALUE Then
        ' Get the rest of the files.
            fname = file_data.cFileName
            fname = Left$(fname, InStr(fname, Chr$(0)) - 1)
            file_names.Add fname
            directories.Add start_dir

            ' Get the next file.
            If FindNextFile(search_handle, file_data) = 0 _
                Then Exit Do

        ' Close the file search hanlde.
        FindClose search_handle
    End If
End Sub
Function ShortFileName uses the GetShortPathName API function to convert a long file name into a short file name.
' Return the short file name for a long file name.
Public Function ShortFileName(ByVal long_name As String) As _
Dim length As Long
Dim short_name As String

    short_name = Space$(1024)
    length = GetShortPathName( _
        long_name, short_name, _
    If length < 1 Then
        MsgBox "Error converting path '" & _
            long_name & "' into a short name", _
            vbExclamation Or vbOKOnly, "Path Error"
        ShortFileName = Left$(short_name, length)
    End If
End Function
Subroutine RandomizeArray randomizes an array. For each entry in the array, it selects a random item at that point or later and swaps it into this position. The result is a randomized array.
' Randomize an array of integers indexed from 1.
Public Sub RandomizeArray(indexes() As Integer)
Dim num_items As Integer
Dim i As Integer
Dim j As Integer
Dim tmp As Integer

    ' Randomize the array.
    num_items = UBound(indexes)
    For i = 1 To num_items - 1
        ' Pick a random entry.
        j = Int((num_items - i + 1) * Rnd + i)

        ' Swap the numbers.
        tmp = indexes(i)
        indexes(i) = indexes(j)
        indexes(j) = tmp
    Next i
End Sub
While this program is intended to be useful, it's still not perfect and doesn't handle every possible error condition. It also doesn't save every possible useful setting such as the program's size and position.
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.