' ************************************************************************************
' Script:		createM3Uplaylist.vbs
' Descripton:	Creates a playlist for mp3 files in the folder holding the song(s)
'				Works on the file structure Artist\Album\TrackNo-SongTitle.mp3
' Author:		Gary Evans - http://www.gary-evans.com
' Date:			28 May 2005
' ************************************************************************************
' Updates/Changes
' Date - Initials - Comment
' 29 May 2005 - ge - Added option for central PlayList location (strM3uDir).
' 29 May 2005 - ge - Added Logging (strLogFile) and Prompts.
' 21 Jul 2006 - ge - Removed blank lines between entries to solve problem with Nokia Music Manager
' 27 Oct 2006 - ge - Added Time to Name of LogFile
' 27 Oct 2006 - ge - Added CURRENT option to m3udir to create playlist at top of tree
' ************************************************************************************
' Disclaimer:  Use at your own risk - No support, no warranty, no nothing not even implied
' If it's useful then I'm glad, if not then sorry but such is life.
' ************************************************************************************
' Usage:  
' 1 - Set the top folder you want to start the search from in the variable strTopFldr
' 2 - Set the Central Play List Location if you want one, else leave/change strM3uDir to = "" or "CURRENT"
' 3 - Run the script
' 4 - Go get a coffee
' ************* Script Initialisation Statement Go Here ******************************
Option Explicit
Dim aryCreated()	'Array Of Playlists Created
Dim aryFileList()	'Arry of filenames
Dim aryNotCreated()	'Array of playlists not created
Dim aryPlayList()	'Array of songs
Dim aryElem			'Elements in Array
Dim objExt			'Extension To Convert From
Dim objFSO			'File System Object
Dim objFSOFW		'File System File Write Object
Dim strAlbum		'Album Name
Dim strAryCount		'Count For Sizing And Increasing Array
Dim strAryCountCP	'Count For Sizing And Increasing Created Playlist Array
Dim strAryCountNC	'Count For Sizing And Increasing Not Created Array
Dim strBand			'Band Name
Dim strBandDir		'Directory Above Band
Dim strBandName		'Band Name
Dim strDir			'Directory from search
Dim strFile			'Filename from search
Dim strFileName		'FIlename of song
Dim strLogFile		'LogFile
Dim strM3uFile		'Playlist File
Dim strM3uDir		'Playlist File
Dim strSongName		'Song Name
Dim strTopFldr		'Top Folder To Search From

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8

strTopFldr = "C:\Documents and Settings\Gary\My Documents\My Music\MP3s"
'strM3uDir = "C:\Documents and Settings\Gary\My Documents\My Music\My Playlists\MP3s"		'Change this to a Directory if you want a central play list directory
																'strM3uDir = ""  will create playlist in each individual directory
																'strM3uDir = "CURRENT"  will create playlist in strTopFldr
strM3uDir = "CURRENT"
strLogFile = strTopFldr&"\PlayListCreate-"&Replace(FormatDatetime(Date, vbShortDate), "/", "")&"_"&Replace(FormatDatetime(Time, vbLongTime), ":", "")&".txt"


' ************* Main Processing Section *********************************************

Call fnGetFolder(strTopFldr)

WScript.Echo "Playlist Creation Started."&vbCrLf&"Searching For MP3 Files Under "&strTopFldr&vbCrLf&"You Will Be Informed When The Process Is Complete"
If strM3uDir = "" Then 
	WScript.Echo "Playlists Will Be Created In"&vbCrLf&"In Each MP3 Folder"
	ElseIf strM3uDir = "CURRENT" Then
		WScript.Echo "Playlists Will Be Created In"&vbCrLf&strTopFldr
	Else
		WScript.Echo "Playlists Will Be Created In"&vbCrLf&strM3uDir
End If

strAryCount = 0
strAryCountCP = 0
strAryCountNC = 0
Call fnGoSubFolders(strTopFldr)

Call fnCreatedList()

Call fnNotCreatedList()

WScript.Echo "Playlist Creation Complete."&vbCrLf&"Check the Log File"&vbCrLf&strLogFile

' ************* Subroutines and Functions Go Here ************************************
Function fnGetFolder(sFolder)
	On Error Resume Next
	Set strTopFldr = objFSO.GetFolder(sFolder)
	If Err.Number <> 0 Then
		WScript.Echo "Problem With MP3 Folder - " &sFolder &vbLf &Err.Description
	Wscript.Quit Err.Number
	End If
End Function

Function fnGoSubFolders(objDir)
	If objDir <> "\System Volume Information" Then
		Call fnCreatePlayList(objDir)
		For Each strDir In objDir.SubFolders
			Call fnGoSubFolders(strDir)
		Next
	End If
End Function


Function fnCreatePlayList(objDir)
		strAryCount = 0
		ReDim aryPlayList(strAryCount)
		ReDim aryFileList(strAryCount)
			For Each strFile In objDir.Files 
			ReDim Preserve aryPlayList(strAryCount)
			ReDim Preserve aryFileList(strAryCount)
			If LCase(objFSO.GetExtensionName(strFile)) = "mp3" Then
			strBandDir = Len(objFSO.GetParentFolderName(objFSO.GetParentFolderName(objFSO.GetParentFolderName(strFile))))+1
			strBand = Len(objFSO.GetParentFolderName(objFSO.GetParentFolderName(strFile)))+1
			strBandName = Mid(objFSO.GetParentFolderName(objFSO.GetParentFolderName(strFile)), (strBandDir + 1), strBand)
			strAlbum = Len(objFSO.GetParentFolderName(strFile)) - strBand
			strAlbum = Right(objFSO.GetParentFolderName(strFile), strAlbum)
			strSongName = Right(objFSO.GetBaseName(StrFile),(Len(objFSO.GetBaseName(StrFile))-3))
			aryPlayList(strAryCount) = Right(objFSO.GetBaseName(StrFile),(Len(objFSO.GetBaseName(StrFile))-3))
				If strM3uDir = "" Then 
					aryFileList(strAryCount) = objFSO.GetFileName(strFile)
					ElseIf strM3uDir = "CURRENT" Then
						aryFileList(strAryCount) = strBandName & "\" & strAlbum & "\" &objFSO.GetFileName(strFile)
					Else 
						aryFileList(strAryCount) = objFSO.GetAbsolutePathName(strFile)
				End If
			strAryCount = strAryCount + 1						
			End If
			Next
			If UBound (aryPlayList) > 0 Then 
			If strM3uDir = "" Then 
				strM3uFile = strBandName&" - "&strAlbum&".m3u"
				ElseIf strM3uDir = "CURRENT" Then
					strM3uFile = strTopFldr&"\"&strBandName&" - "&strAlbum&".m3u"
					Else 					
					strM3uFile = strM3uDir&"\"&strBandName&" - "&strAlbum&".m3u"
					If Not objFSo.FolderExists(strM3uDir) Then
						objFSO.CreateFolder(strM3uDir)
					End If				
			End If
				If objFSO.FileExists(strM3uFile) Then
					ReDim Preserve aryNotCreated(strAryCountNC)
					aryNotCreated(strAryCountNC) = strBandName&" - "&strAlbum
					strAryCountNC = strAryCountNC + 1
					Exit Function
				End If
			objFSO.CreateTextFile strM3uFile, False, False
			ReDim Preserve aryCreated(strAryCountCP)
			aryCreated(strAryCountCP) = strBandName&" - "&strAlbum
			strAryCountCP = strAryCountCP + 1
			Set objFSOFW = objFSO.OpenTextFile(strM3uFile, ForAppending, False)
			objFSOFW.WriteLine "#EXTM3U"
			End If
			For aryElem = LBound(aryPlayList) To UBound(aryPlayList)
			If Len(aryPlayList(aryElem)) > 0 Then
			objFSOFW.WriteLine "#EXTINF:0,"&strBandName&" - "&aryPlayList(aryElem)
			objFSOFW.WriteLine aryFileList(aryElem)
			'objFSOFW.WriteBlankLines 1
			End If
			Next
End Function


Function fnCreatedList()
	If strAryCountCP > 0 Then
		Set objFSOFW = objFSO.OpenTextFile(strLogFile, ForAppending, True)
		objFSOFW.WriteLine "Playlist Creation Completed"
		objFSOFW.WriteLine "The Following "&strAryCountCP&" Album Playlist(s) Were Created"
		If strAryCountCP < 10 Then
			objFSOFW.WriteLine "=============================================="
			Else
			objFSOFW.WriteLine "==============================================="
		End If
		For Each aryElem In aryCreated
		objFSOFW.WriteLine aryElem
		Next
		objFSOFW.WriteBlankLines 2
		objFSOFW.Close
	End If
End Function


Function fnNotCreatedList()
	If strAryCountNC > 0 Then
		Set objFSOFW = objFSO.OpenTextFile(strLogFile, ForAppending, True)
		objFSOFW.WriteLine "Playlist Creation Encountered Problems"
		objFSOFW.WriteLine "The Following "&strAryCountNC&" Album(s) Did Not Have A Playlist Created"
		If strAryCountNC < 10 Then
			objFSOFW.WriteLine "========================================================"
			Else
			objFSOFW.WriteLine "========================================================="
		End If
		For Each aryElem In aryNotCreated
		objFSOFW.WriteLine aryElem
		Next
		objFSOFW.WriteBlankLines 2
		objFSOFW.Close
	End If
End Function