Jump to content

Dynamic Xml Playlist Generator


Recommended Posts

Hi,I have an offline xspf playlist generator I found on the web that works well offline.Now I want to be able to call or execute the vbs file with my mp3 files on the server in order for the playlist.xml file to be updated everytime the page is visited. This way, all i need to do is to upload my mp3 on the server and my mp3player will have updated list everytime the page loads (i guess there is a tricky part there. xml needs to be updated before my mp3player start loading otherwise it will load the playlist before it is updated)Here is the code of the vbs file

'*********************************************************************************'TITLE:		XSPF Playlister' 'author:	charlie craig, craigcharlieATSYMBOLhotmail.com'date:		02.06.2008'version:	2.0'description:	XPSF playlist encoder. Processes one folder multiple formats, out'''BASED ON: 	Mp3Playlister_singleList.vbs'orig. author:	la_boost@yahoo.com'found at:	www.interclasse.com/scripts/ Mp3Playlister_singleList.php'orig. date:	13.04.2002'version:	1.1'  '*********************************************************************************'***********************************'BEGIN'***********************************Option ExplicitConst ForReading = 1, ForWriting = 2, ForAppending = 8Dim fso, WshShell, cptTot, objArgs, arrFiles(), sExtToGetArrDim driveLetter, pathToScan, fold, nTime, sAppNameSet fso = CreateObject("Scripting.FileSystemObject")Set WshShell = WScript.CreateObject("WScript.Shell")sAppName = "XPSF Playlister - Recursive playlist generator"'CC the location that the script should output todim outputDir dim fScriptset fScript = fso.GetFile(WScript.ScriptFullName)outputDir = fScript.parentFolder.Path'-- File extensions to include in playlist:sExtToGetArr = Array("wmv") '-- playlist file extensionConst sPlaylistExt = "xml"	Set objArgs = WScript.Argumentsif ( objArgs.Count = 0 ) then	WshShell.Popup "You must specify a directory to scan. ", 30, sAppName, 48		WScript.Quitend ifpathToScan = objArgs(0)if ucase(left(pathToScan, len(outputDir))) <> ucase(outputDir) then	WshShell.Popup "You may only scan folders that are located in the same directory as this script "& Chr(13) &"(i.e., within """ & outputDir & """).", 30, sAppName, 48	WScript.Quitend ifnTime = Timer'-- start scanningCall startScanning()'-- cleanSet fso = nothingSet WshShell = nothing					'***********************************'END'***********************************'***********************************'FUNCTIONS:'***********************************Sub startScanning()	Dim i, cpt, playlistPath	cptTot = 0 	If fso.FolderExists(pathToScan) Then		ReDim arrFiles(0)		Set fold = fso.Getfolder(pathToScan)		playlistPath = outputDir &"\"& "playlist" & "." & sPlaylistExt				'CC old playlistPath = fold.path &"\"& fold.Name & "." & sPlaylistExt		'-- recurse folder				Call DoIt(fold)					Else	 			WshShell.Popup "This script only works with folders. It cannot process """& pathToScan &""".", 5, sAppName, 48	 	Wscript.quit		 	End If					 	'-- save playlist if more than 0 entry in it		 	If (UBound(arrFiles) > 0) Then 	Call Quicksort(arrFiles,0,cptTot-1) 	 	'CC In order to have randomized output, uncomment the following "Randomizer Function" section.  '   Me, I prefer randomness.''***********************************' Randomizer Function'***********************************''Dim intRnd, AryRnd(), arrDupe(), x, z, bexists'z = 0'Randomize  'ReDim AryRnd(0)'ReDim arrDupe(0)''for x = 0 to (cptTot-1)''	 ReDim Preserve AryRnd(UBound(AryRnd)+1)''	 AryRnd(x) = arrFiles(x)''next''for x = 0 to (cptTot-1)''	 ReDim Preserve arrDupe(UBound(arrDupe)+1)''	 arrDupe(x) = arrFiles(x)''next''CC don't forget that arrays start at zero, the total number of files is the array length +1''while z < cptTot''intRnd = Int((cptTot * Rnd) + 1) 'bexists = false''for x = 0 to cptTot'	 If AryRnd(x) = intRnd then'		  bexists = true		  '		  exit for '	 End if'next''if bexists = false then'	 AryRnd(z) = intRnd '	 arrFiles(z)=arrDupe(intRnd-1)'	 z = z + 1'end if'Wend ''***********************************'CC Randomizer Function End'***********************************			Call createAndSavePlaylist(arrFiles, playlistPath)				Else				WshShell.Popup "The folder """& pathToScan &""" does not contain any of the filetypes defined in this script."& Chr(13) & Chr(13) &"To add support for new filetypes, edit the script and add the desired file extensions to the sExtToGetArr array."& Chr(13) & Chr(13), 0, sAppName, 64			End If			End Sub '*********************************************************************************Sub AddFiles(fold)'-- process all mp3 files in the fold folder	Dim strExt, mpFiles, strName, foldName, foldPath, f, sulength, suname, leslash			foldPath = fold.Path	Set mpfiles = fold.Files		For each f in mpfiles		strName = f.Name		strExt = LCase(fso.GetExtensionName(strName))					'-- CC to solve issue with an output root directory having a backslash that's not part of the length of the foldPath string			If len(outputDir) = 3 Then			sulength = len(foldPath) -  len(outputDir) + 1			Else			sulength = len(foldPath) -  len(outputDir)			End If				'-- CC these variables enable outputting the string for the relative path beginning with the folder being scanned.		suname = len(foldPath) -  (len(pathToScan))		If suname = 0 Then		leslash=""		Else		leslash="/"		End If		'-- leslash adds a "/" before folder names to show that it's a directory, this helps distinguish folders from files during the sorting, otherwise folders are sorted the same as files. 						dim ExtIterate 'This integer used to iterate through file extension array.						For ExtIterate = 0 to UBound(sExtToGetArr)					  		If strExt = sExtToGetArr(ExtIterate) Then				'-- CC This is the string that outputs tags for individual files.				arrFiles(cptTot) = Replace((vbTab & "<track>"& vbCrLf& vbTab & vbTab & vbTab & "<title>"&Replace((Replace((Right(foldPath, suname)),"\","/")),"&","&")& leslash & Replace(((UCase(Left (strName, 1))) & Mid(strName,2,Len(strName))),"&","&")&"</title>"& vbCrLf & vbTab & vbTab & vbTab &"<location>" & Replace((Replace((Right(foldPath, sulength-1)),"\","/")),"&","&")&"/"&Replace(((Left (strName, 1)) & Mid(strName,2,Len(strName))),"&","&")&"</location>"& vbCrLf & vbTab &"</track>"& vbCrLf), "'","'")							ReDim Preserve arrFiles(UBound(arrFiles)+1)		cptTot = cptTot + 1	'-- global counter for processed files				End If				Next	NextEnd Sub'*********************************************************************************   Sub createAndSavePlaylist(arrFiles, playlistPath)	Dim txt, txtFile	'-- create XPSF file (Unicode)	If Not fso.FileExists(playlistPath) Then		Set txtFile = fso.CreateTextFile(playlistPath,true,true) 'Unicode!!	End If	Set txtFile = fso.GetFile(playlistPath)	Set txt = txtFile.OpenAsTextStream(ForWriting, -1)'0 for ASCII, -1 for Unicode	'-- write XML header info	txt.write("<?xml version="&Chr(34)&"1.0"&Chr(34)& " encoding=" & Chr(34) &  "UTF-8" & Chr(34) &"?>")	txt.write(vbCrLf)	txt.write("<playlist version="&Chr(34)&"1"&Chr(34)&" xmlns="&Chr(34)&"http://xspf.org/ns/0/"&Chr(34)&">")	txt.write(vbCrLf)	txt.write("<title>Your MP3 Playlist</title>")	txt.write(vbCrLf)	txt.write("<info>http://YourWebpageHere/</info>")	txt.write(vbCrLf)	txt.write(vbCrLf)	txt.write("<trackList>")	txt.write(vbCrLf)	  txt.write(vbCrLf)	txt.write Join(arrFiles, vbCrLf)	txt.write(vbCrLf)	txt.write("</trackList>")	txt.write(vbCrLf)	txt.write("</playlist>")	txt.close		'***************************************************************'Reencode file from Unicode to UTF-8'***************************************************************'CC - Added this section to re-encode file as UTF-8, there's probably a neater'  way, but this is a quick fix.Dim objStreamDim objStream2'Create streamsSet objStream = CreateObject("ADODB.Stream")set objStream2= CreateObject("ADODB.Stream")'Initialize the streamsobjStream.OpenobjStream2.Open'Set charactor encoding for output streamobjStream.Position = 0objStream.Charset = "UTF-8"objStream.Type = 2  'Sets file type as text data 'Read Unicode file into input text streamobjStream2.LoadFromFile txtFile	'Copy Unicode stream into UTF-8 streamobjStream2.CopyTo objStream'Save the UTF-8 stream back into the original fileobjStream.SaveToFile txtFile,2objStream.CloseobjStream2.Close'***************************************************************'End of UTF-8 Reencode'***************************************************************dim openplaylistopenplaylist = WshShell.Popup ("Finished. "  & chr(13) & chr(13) & cptTot & " files have been playlisted in the following file:"& Chr(13)& Chr(13) & Replace(Replace(playlistPath,"\","/"),"//","/") & Chr(13) & Chr(13) & "**********************************************************************"& Chr(13) & "WARNING: IF YOU EDIT THIS FILE, MAKE SURE TO SAVE IT IN UTF-8 ENCODING"& Chr(13) & "**********************************************************************"& Chr(13) & Chr(13) & showTime(nTime)& Chr(13) & Chr(13) & Chr(13) & "Would you like to view your playlist?", 0,sAppName, 324)If openplaylist = 6 Then WshShell.Run "explorer.exe " & """" & Replace(playlistPath,"\\","\") & """"End IfEnd 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)	NextEnd 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'*********************************************************************************

it works by simply dragging the folder over that file (xspf_playlist_generator.vbs) and it will output a playlist in xspf format.Here is the playlist output format

<?xml version="1.0" encoding="UTF-8"?><playlist version="1" xmlns="http://xspf.org/ns/0/"><title>TITLE</title><info>http://www.yoursite.com/</info><trackList>	<track>			<title>title</title>			<location>some_music.mp3</location>	</track>	<track>			<title>title</title>			<location>some_music.mp3</location>	</track>	<track>			<title>title</title>			<location>some_music.mp3</location>	</track>	<track>			<title>title</title>			<location>some_music.mp3</location>	</track>	<track>			<title>title</title>			<location>some_music.mp3</location>	</track>	<track>			<title>title</title>			<location>some_music.mp3</location>	</track></trackList></playlist>

Anyone knows how can I use this xspf generator online?Thanks

Edited by green_apple
Link to comment
Share on other sites

I'm not sure what this has to do with PHP, but you can't use that generator online, it reads a local file structure. If you want to read a remote file structure you'll probably need to write code that opens an FTP connection to the server, logs in, finds the directory, and lists the files. That's substantially different than what you've got, it's more of an entirely new script than changes to this script. The only thing they'll have in common is that they both write the same output.

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

  • Create New...