Mp3Playlister - multiList

recursive m3u playlists generator

'*********************************************************************************
'script		: Mp3Playlister_multiList.vbs
'description: recursive m3u playlists generator :
'				create one playlist for each folder/subfolder containing 
'				mp3 files in the user specified path(s), all playlists 
'				are saved in each user specified path(s) and use absolute paths
'usage		: create a shortcut to this file in the "SendTo" folder or drag-drop folders on it
'date			: 20.04.2002
'version		: 1.2
'				- 1.2 : add customized name(s) for playlists folder(s)
'				- 1.2 : use WScript.Arguments for multiple folders
'				- 1.2 : remove user interaction (no more input dialog)
'				- 1.1 : use WScript.Arguments for single folder
'				- 1.0	: initial
'author		: [email protected]
'*********************************************************************************

'***********************************
'BEGIN
'***********************************
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const sAppName = "Mp3Playlister - Recursive playlist generator"
'-- lowercase file extension to search for
Const sExtToGet = "mp3"		
'-- playlist file extension
Const sPlaylistExt = "m3u"	
'-- playlists folders naming
Const sPrefixFolder = "0-- "
Const sPostfixFolder = " --0"

Dim fso, WshShell, cptTot, objArgs, arg, dicPlaylistsPath
Dim driveLetter, sScannedFoldName, nTime
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set dicPlaylistsPath = CreateObject("Scripting.Dictionary")
cptTot = 0 
nTime = Timer

Set objArgs = WScript.Arguments
if (objArgs.Count = 0) then
	WshShell.Popup "You must specify a directory. ", 5, sAppName, 48
	WScript.Quit
End If

'-- start scanning
Call startScanning()
Call endPopup()

'-- explore playlists (open the last scanned folder only)
'Call explore(dicPlaylistsPath.item(sScannedFoldName))
'-- clean
Set fso = nothing
Set WshShell = nothing					
Set dicPlaylistsPath = nothing
'***********************************
'END
'***********************************


'***********************************
'FUNCTIONS:
'***********************************

Sub startScanning()
	Dim arg, fold	
	'-- loop on user defined paths
	For each arg in objArgs
		If fso.FolderExists(arg) Then		
			Set fold = fso.Getfolder(arg)
			sScannedFoldName = fold.Name
			driveLetter = fold.Drive
			'-- get folder for saving the playlists
			Call setPlaylistsSavePath(sScannedFoldName)	
			'-- recurse folder
			Call DoIt(fold)		
		End If
	Next
End Sub 
'*********************************************************************************

Sub endPopup()
	WshShell.Popup "Finished. "  & chr(13) & chr(13) & cptTot & _
					" files have been playlisted (total) in " & chr(13) & _
					Join(dicPlaylistsPath.items, vbCrLf) & Chr(13) & Chr(13) & _
					showTime(nTime), 0, sAppName, 64	
End Sub
'*********************************************************************************
				
Sub AddFiles(fold)
'-- process all mp3 files in the fold folder and save as playlist
	Dim strExt, mpFiles, strName, arrFiles(), foldPath, cpt, f
	ReDim arrFiles(0)
	cpt = 0
	foldPath = fold.Path
	Set mpfiles = fold.Files
	
	For each f in mpfiles
		strName = f.Name
		strExt = LCase(fso.GetExtensionName(strName))
		If strExt = sExtToGet Then
			arrFiles(cpt) = foldPath &"\"& UCase(Left(strName, 1)) & Mid(strName,2,Len(strName))
			ReDim Preserve arrFiles(UBound(arrFiles)+1)	
			cpt = cpt + 1
		End If
	Next

	'-- save playlist if more than 0 entry in it
	If (UBound(arrFiles) > 0) Then
		cptTot = cptTot + cpt	'-- global counter for processed files
		Call Quicksort(arrFiles,0,cpt-1)
		Call createAndSavePlaylist(arrFiles, fold.Name)		
	End If		
End Sub
'*********************************************************************************
   
Sub createAndSavePlaylist(arrFiles, foldName)
	Dim txt, txtFile, txtPath
	'-- m3u file path
	txtPath = dicPlaylistsPath.item(sScannedFoldName) & foldName &"."& sPlaylistExt
	'-- create m3u file (ASCII)
	If Not fso.FileExists(txtPath) Then
		Set txtFile = fso.CreateTextFile(txtPath,true,false)	'ASCII !!
	End If
	Set txtFile = fso.GetFile(txtPath)
	Set txt = txtFile.OpenAsTextStream(ForWriting, 0)	'ForWriting	, 0 for ASCII (-1 for Unicode)
	
	'-- write m3u entries
	txt.write Join(arrFiles, vbCrLf)
	txt.close
	Set txtFile = nothing
End Sub
'*********************************************************************************
   
Sub DoIt(fold)
'-- recursive scan
	Dim sfold, sfoo
   Call AddFiles(fold)			'process files in current folder
	Set sfold = fold.subfolders 
	for each sfoo in sfold 		'process files in subfolders
		Call DoIt(sfoo)
	Next
End Sub  
'*********************************************************************************

Sub explore(path)
'-- open windows explorer 
	WshShell.Run "explorer "& path
	WScript.Sleep 100
	WshShell.AppActivate "explorer"
End Sub
'*********************************************************************************

Sub setPlaylistsSavePath(foldName)
	Dim sPlaylistsPath
	sPlaylistsPath = driveLetter &"\"& sPrefixFolder & foldName & sPostfixFolder &"\"
	dicPlaylistsPath.add foldName, sPlaylistsPath
 
	If Not fso.FolderExists(sPlaylistsPath) Then
	 	'WshShell.Popup "Creating playlist folder. " & sPlaylistsPath, 1, sAppName, 64
		fso.CreateFolder(sPlaylistsPath)
	End If
End Sub
'*********************************************************************************

Function showTime(nTime)
	showTime = "Elapsed time : " & Round((Timer - nTime),2) &" seconds"
End Function
'*********************************************************************************

Sub QuickSort(vec,loBound,hiBound)
  Dim pivot,loSwap,hiSwap,temp

  '== This procedure is adapted from the algorithm given in:
  '==    Data Abstractions & Structures using C++ by
  '==    Mark Headington and David Riley, pg. 586
  '== Quicksort is the fastest array sorting routine for
  '== unordered arrays.  Its big O is  n log n

  '== Two items to sort
  if hiBound - loBound = 1 then
    if vec(loBound) > vec(hiBound) then
      temp=vec(loBound)
      vec(loBound) = vec(hiBound)
      vec(hiBound) = temp
    End If
  End If

  '== Three or more items to sort
  pivot = vec(int((loBound + hiBound) / 2))
  vec(int((loBound + hiBound) / 2)) = vec(loBound)
  vec(loBound) = pivot
  loSwap = loBound + 1
  hiSwap = hiBound
  
  do
    '== Find the right loSwap
    while loSwap < hiSwap and vec(loSwap) <= pivot
      loSwap = loSwap + 1
    wend
    '== Find the right hiSwap
    while vec(hiSwap) > pivot
      hiSwap = hiSwap - 1
    wend
    '== Swap values if loSwap is less then hiSwap
    if loSwap < hiSwap then
      temp = vec(loSwap)
      vec(loSwap) = vec(hiSwap)
      vec(hiSwap) = temp
    End If
  loop while loSwap < hiSwap
  
  vec(loBound) = vec(hiSwap)
  vec(hiSwap) = pivot
  
  '== Recursively call function .. the beauty of Quicksort
    '== 2 or more items in first section
    if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1)
    '== 2 or more items in second section
    if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound)

End Sub  'QuickSort
'*********************************************************************************