Mp3Playlister - multiList

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

File Name : Mp3Playlister_multiList.vbs
Requirement : mp3 files
Author : la boost
Submitted : 20/04/2002
Category : Other
'*********************************************************************************
'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		: la_boost@yahoo.com
'*********************************************************************************

'***********************************
'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
'*********************************************************************************
Server Info
Remote Info
Compress

Batchs
BootSector
Droit
Accessoire GFA
On Now
Ecran plasma
Système d'exploitation
Son
Unités
Scripting
Multilingue
Site Web
Bruit et son
Architecture Google


4K
Color picker
TaskList
Backup files
Mini Port Scanner
Website To CHM
PixyDemo
Web password recovery
4KWebServer
Kill Popup
VBE decoder
Script Optimizer
Database Password Recovery
Class
Ini
EMail validator
Graphical Class
MP3 Info
Pinger Class
IP ranger class
SoftwareMetering
Path Validator
Time Stamper Class
LoggerCLS
HTA
Keyword Ranking
DOM Explorer
HTA-Notepad
PixyPortManager
Other
flashMessage
Kill Popup
VBE decoder (fixed)
Error Codes
Maze generator
Char counter
HTML To Word
ICQ Choose User
ScreenSaver Password decoder
Mp3Playlister - singleList
Long Filename To Short
Trace Math
Dump Hexa File
Self modifying script
Mp3Playlister - multiList
HTANoid
PixyWebServer
Python
Progress indication

©2002 Jean-Luc Antoine. All Rights Reserved. Scripts or any other material on this website may not be redistributed or put as part of ANY collection (script archives, CDs etc) without prior written permission. Permission granted to use and modify any of the scripts found on InterClasse.com