'**************************************
' Name: Windows Media Player Play-List
' Description:This code allows you to drag and drop multiple audio-visual files directly onto the script file.
The code then searches for the playlist, if the playlist doesn't exist, the first function
creates a playlist called "MyPlayList.wpl" on the desktop.
The script then calls a modify playlist function to add the music file location and name to the playlist. It was written for windows media player version 9.0 but you can easily alter that if you need too.
' By: A_X_O
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=9783&lngWId=4'for details.'**************************************
' The File Version: 2.0 [FINAL]- No more involvement
'
'Modifications
'
'Ver 1.0: saturday 08 october 2011 - Dimension errors, timeout error, error resumptions [fixed]
'Ver 1.0:saturday 15 october 2011 - File name error [fixed]
'
'Ver 2.0: tuesday 18 october 2011 - Implimented multiple file drops.
'
Dim FSO, WShell
Dim TheDesktop, ThePlayList
Dim TheFileName, TheFileList, AudioVisualFile
'
Const PlayList = "\MyPlayList.wpl"
Const ERROR_Tx = "Error in the file name"
Const ERROR_Ex = "WMP Ver. 9.0 Does not allow ampersand in the file name"
Const FrontTag = "<media src="
Const EndTag = "/>"
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WShell = CreateObject("WScript.Shell")
'
TheDesktop = WShell.SpecialFolders("Desktop")
ThePlayList = ((TheDesktop)&(PlayList))
'
For Each AudioVisualFile In WScript.Arguments
'
Set FileInfo = FSO.GetFile(AudioVisualFile)
'
TheFileName = FSO.GetFileName(FileInfo)
'
If InStr(1,(TheFileName),Chr(38)) Then
Msgbox (TheFileName)& vbcrlf & ERROR_Ex,, ERROR_Tx
WScript.Quit
End If
'
TheFileList = (TheFileList & (FrontTag) &Chr(34)& AudioVisualFile & Chr(34)& (EndTag)&vbcrlf)
'
Next
'
If (FSO.FileExists(ThePlayList)) Then
Call ModifyPlayList(ThePlayList)
Else
Call CreatePlayList(ThePlayList)
End If
'
Function ModifyPlayList(ThePlayList)
On Error Resume Next
'
Dim AltString, F, ModifyAudioVisualFile
Dim ReadFile, ModifiedList
'
Const ForReading = 1, ForWriting = 2
Const TagID = "</seq>"
'
AltString = ((TheFileList)&VbCrLf&(TagID))
'
Set F = FSO.OpenTextFile((ThePlayList), ForReading)
ReadFile = F.ReadAll
'
If InStr(1, (ReadFile), (TagID)) Then
ModifyAudioVisualFile = Replace((ReadFile),(TagID),(AltString))
Set ModifiedList = FSO.OpenTextFile((ThePlayList), ForWriting, True)
'
With ModifiedList
.Write (ModifyAudioVisualFile)
.Close
End With
'
End If
'
End Function
'
Function CreatePlayList(ThePlayList)
'
On Error Resume Next
'
Dim CodeArray(5), ArrCode, MakeTheFile
Dim a, b, c, d, e
'
Const J = "500"
'
a = "<?wpl version=" & Chr(34) & "1.0" &Chr(34) & "?>" & vbcrlf
b = "<smil>" &vbcrlf& "<head>" &vbcrlf
c = "<meta name="&chr(34)&"Generator"&Chr(34)&" content="&Chr(34)&"Microsoft Windows Media Player -- 9.0.0.4510" & Chr(34) & "/>" & vbcrlf
d = "<author/>" &vbcrlf & "<title>New Playlist (1)</title>" &vbcrlf & "</head>" & vbcrlf
e = "<body>" &vbcrlf& "<seq>" &vbcrlf & "</seq>" &vbcrlf & "</body>" & vbcrlf & "</smil>" & vbcrlf
'
CodeArray(0) = a :CodeArray(2) = c :CodeArray(4) = e
CodeArray(1) = b :CodeArray(3) = d
'
Set MakeTheFile = FSO.CreateTextFile(ThePlayList, True)
For ArrCode = 0 to UBound(CodeArray)
MakeTheFile.Write(CodeArray(ArrCode))
Next
'
MakeTheFile.Close
'
WScript.Sleep((J)*9): Call ModifyPlayList(ThePlayList)
'
End Function
|
