Batch M3U Creator 2.7 - Updated 23/09/2012
Posted: Mon Jul 17, 2006 9:17 am
This script, as requested, creates an M3U playlist for each album in your library. If you have tracks selected when you run the script then there is the option to limit the batch to just those albums. The playlists are saved in the album folder (same folder as the first track in the album).
The installer can be downloaded from my website!
The installer can be downloaded from my website!
Code: Select all
'
' MediaMonkey Script
'
' NAME: BatchM3UCreator 2.7
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 23/09/2012
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini
' Don't forget to remove comments (') and set the order appropriately
'
' [BatchM3UCreator]
' FileName=BatchM3UCreator.vbs
' ProcName=BatchM3UCreator
' Order=33
' DisplayName=Batch M3U Creator
' Description=Creates an M3U playlist for each album
' Language=VBScript
' ScriptType=0
'
' Mask fields: <Artist><Album><Year><Tracks><Length><Rating><Discs><Path1><Path2><Path3>
'
' FIXES: Added 7 extra mask fields
'
Option Explicit
Dim logf : Set logf = Nothing
Dim Debug : Debug = False
Dim FullPath : FullPath = False
Dim Directory : Directory = "" 'leave blank to put playlists in album folders
Dim FileMask : FileMask = "<Artist> - <Album> (<Year>)"
Dim AlbumOnly : AlbumOnly = False 'ignore tracks not in the album folder
Dim UpOneLevel : UpOneLevel = False 'create playlists in the folder above album folder
Dim Unicode : Unicode = 0
Dim OldPath : OldPath = ""
Dim NewPath : NewPath = ""
Sub BatchM3UCreator
'create progress bar
Dim prog : Set prog = SDB.Progress
Dim sql : sql = "SELECT Count(*) FROM Albums WHERE ID>0 AND Album!=''"
Dim iter : Set iter = SDB.Database.OpenSQL(sql)
prog.MaxValue = iter.ValueByIndex(0)
prog.Value = 0
prog.Text = "BatchM3UCreator: Initialising..."
SDB.ProcessMessages
'load settings
Dim ini : Set ini = SDB.IniFile
If ini.ValueExists("BatchM3UCreator","Debug") Then
Debug = ini.BoolValue("BatchM3UCreator","Debug")
Else
ini.BoolValue("BatchM3UCreator","Debug") = Debug
End If
If ini.ValueExists("BatchM3UCreator","Directory") Then
Directory = ini.StringValue("BatchM3UCreator","Directory")
Else
ini.StringValue("BatchM3UCreator","Directory") = Directory
End If
If ini.ValueExists("BatchM3UCreator","FileMask") Then
FileMask = ini.StringValue("BatchM3UCreator","FileMask")
Else
ini.StringValue("BatchM3UCreator","FileMask") = FileMask
End If
If ini.ValueExists("BatchM3UCreator","FullPath") Then
FullPath = ini.BoolValue("BatchM3UCreator","FullPath")
Else
ini.BoolValue("BatchM3UCreator","FullPath") = FullPath
End If
If ini.ValueExists("BatchM3UCreator","AlbumOnly") Then
AlbumOnly = ini.BoolValue("BatchM3UCreator","AlbumOnly")
Else
ini.BoolValue("BatchM3UCreator","AlbumOnly") = AlbumOnly
End If
If ini.ValueExists("BatchM3UCreator","UpOneLevel") Then
UpOneLevel = ini.BoolValue("BatchM3UCreator","UpOneLevel")
Else
ini.BoolValue("BatchM3UCreator","UpOneLevel") = UpOneLevel
End If
If ini.ValueExists("BatchM3UCreator","Unicode") Then
Unicode = ini.IntValue("BatchM3UCreator","Unicode")
Else
ini.IntValue("BatchM3UCreator","Unicode") = Unicode
End If
If ini.ValueExists("BatchM3UCreator","OldPath") Then
OldPath = ini.StringValue("BatchM3UCreator","OldPath")
Else
ini.StringValue("BatchM3UCreator","OldPath") = OldPath
End If
If ini.ValueExists("BatchM3UCreator","NewPath") Then
NewPath = ini.StringValue("BatchM3UCreator","NewPath")
Else
ini.StringValue("BatchM3UCreator","NewPath") = NewPath
End If
'check selected
Dim i : i = 0
Dim tot : tot = 0
Dim list : Set list = SDB.SelectedSongList
If Not (list Is Nothing) Then
If list.Count = 0 Then
Set list = Nothing
Else
tot = list.Albums.Count
For i = 0 To list.Count-1
If list.Item(i).Album.ID = 0 Then
tot = tot-1
Exit For
End If
Next
End If
End If
'check filter
Dim fin : fin = ""
Dim fis : fis = ""
If SDB.Database.ActiveFilterID > -1 Then
fis = SDB.Database.ActiveFilterQuery
If Not (fis = "") Then
fis = " AND "&fis
End If
Dim itr : Set itr = SDB.Database.OpenSQL("SELECT Name FROM Filters WHERE ID="&SDB.Database.ActiveFilterID)
If itr.EOF Then
fis = ""
Else
fin = itr.StringByIndex(0)
End If
Set itr = Nothing
End If
'show confirmation screen
Dim Form : Set Form = SDB.UI.NewForm
Form.Common.SetRect 100, 100, 350, 335
Form.BorderStyle = 3 ' Non-Resizable
Form.FormPosition = 4 ' Screen Center
Form.SavePositionName = "BatchM3UCreatorPos"
Form.Caption = "Batch M3U Creator"
Dim Label : Set Label = SDB.UI.NewLabel(Form)
Label.Caption = "Creation mode:"
Label.Common.Left = 10
Label.Common.Top = 15
Dim DrpMode : Set DrpMode = SDB.UI.NewDropdown(Form)
DrpMode.Common.Left = 92
DrpMode.Common.Top = Label.Common.Top -4
DrpMode.Common.Width = 230
If tot > 0 Then
DrpMode.AddItem("Selected: "&tot&" albums")
End If
If Not (fin = "") Then
DrpMode.AddItem("Filtered: "&fin)
End If
DrpMode.AddItem("Entire library")
DrpMode.ItemIndex = 0
DrpMode.Style = 2
Dim Label2 : Set Label2 = SDB.UI.NewLabel(Form)
Label2.Caption = "Root direcory:"
Label2.Common.Left = 10
Label2.Common.Top = Label.Common.Top +25
Dim EdtDirectory : Set EdtDirectory = SDB.UI.NewEdit(Form)
EdtDirectory.Common.Left = DrpMode.Common.Left
EdtDirectory.Common.Top = Label2.Common.Top -2
EdtDirectory.Common.Width = 208
EdtDirectory.Common.Hint = "Leave blank to put playlists in album folders"
EdtDirectory.Common.ControlName = "Directory"
EdtDirectory.Text = Directory
Dim BtnDirectory : Set BtnDirectory = SDB.UI.NewButton(Form)
BtnDirectory.Common.Left = EdtDirectory.Common.Left + EdtDirectory.Common.Width +2
BtnDirectory.Common.Top = EdtDirectory.Common.Top
BtnDirectory.Common.Width = 20
BtnDirectory.Common.Height = EdtDirectory.Common.Height
BtnDirectory.Common.Hint = "Browse"
BtnDirectory.Caption = "..."
Call Script.RegisterEvent(BtnDirectory,"OnClick","BrowseDirectory")
Set SDB.Objects("BatchM3UCreatorButton") = BtnDirectory
Dim Label3 : Set Label3 = SDB.UI.NewLabel(Form)
Label3.Caption = "Filename mask:"
Label3.Common.Left = 10
Label3.Common.Top = Label2.Common.Top +25
Dim EdtFileMask : Set EdtFileMask = SDB.UI.NewEdit(Form)
EdtFileMask.Common.Left = DrpMode.Common.Left
EdtFileMask.Common.Top = Label3.Common.Top -2
EdtFileMask.Common.Width = DrpMode.Common.Width
EdtFileMask.Common.Hint = "Can include: <Artist><Album><Year><Tracks><Length><Rating><Discs><Path1><Path2><Path3>"
EdtFileMask.Text = FileMask
Dim Label4 : Set Label4 = SDB.UI.NewLabel(Form)
Label4.Caption = "Unicode mode:"
Label4.Common.Left = 10
Label4.Common.Top = Label3.Common.Top +25
Dim DrpUnicode : Set DrpUnicode = SDB.UI.NewDropdown(Form)
DrpUnicode.Common.Left = DrpMode.Common.Left
DrpUnicode.Common.Top = Label4.Common.Top -2
DrpUnicode.Common.Width = DrpMode.Common.Width
DrpUnicode.AddItem("Convert to ASCII (.m3u)")
DrpUnicode.AddItem("Save as unicode (.m3u)")
DrpUnicode.AddItem("Save as unicode (.m3u8)")
DrpUnicode.AddItem("Mixed mode (.m3u/.m3u8)")
DrpUnicode.ItemIndex = Unicode
DrpUnicode.Style = 2
Dim Label5 : Set Label5 = SDB.UI.NewLabel(Form)
Label5.Caption = "Old prefix:"
Label5.Common.Left = 10
Label5.Common.Top = Label4.Common.Top +25
Dim EdtOldPath : Set EdtOldPath = SDB.UI.NewEdit(Form)
EdtOldPath.Common.Left = DrpMode.Common.Left
EdtOldPath.Common.Top = Label5.Common.Top -2
EdtOldPath.Common.Width = DrpMode.Common.Width
EdtOldPath.Text = OldPath
Dim Label6 : Set Label6 = SDB.UI.NewLabel(Form)
Label6.Caption = "New prefix:"
Label6.Common.Left = 10
Label6.Common.Top = Label5.Common.Top +25
Dim EdtNewPath : Set EdtNewPath = SDB.UI.NewEdit(Form)
EdtNewPath.Common.Left = DrpMode.Common.Left
EdtNewPath.Common.Top = Label6.Common.Top -2
EdtNewPath.Common.Width = DrpMode.Common.Width
EdtNewPath.Text = NewPath
Dim ChkFullPath : Set ChkFullPath = SDB.UI.NewCheckbox(Form)
ChkFullPath.Common.Left = 10
ChkFullPath.Common.Top = Label6.Common.Top +25
ChkFullPath.Common.Width = 265
ChkFullPath.Caption = "Write full track path?"
ChkFullPath.Checked = FullPath
Dim ChkAlbumOnly : Set ChkAlbumOnly = SDB.UI.NewCheckbox(Form)
ChkAlbumOnly.Common.Left = 10
ChkAlbumOnly.Common.Top = ChkFullPath.Common.Top +25
ChkAlbumOnly.Common.Width = 265
ChkAlbumOnly.Caption = "Ignore tracks not in the album folder?"
ChkAlbumOnly.Checked = AlbumOnly
Dim ChkUpOneLevel : Set ChkUpOneLevel = SDB.UI.NewCheckbox(Form)
ChkUpOneLevel.Common.Left = 10
ChkUpOneLevel.Common.Top = ChkAlbumOnly.Common.Top +25
ChkUpOneLevel.Common.Width = 265
ChkUpOneLevel.Caption = "Create playlists in folder above album folder?"
ChkUpOneLevel.Checked = UpOneLevel
Dim ChkDebug : Set ChkDebug = SDB.UI.NewCheckbox(Form)
ChkDebug.Common.Left = 10
ChkDebug.Common.Top = ChkUpOneLevel.Common.Top +25
ChkDebug.Common.Width = 265
ChkDebug.Caption = "Create debug logfile?"
ChkDebug.Checked = Debug
Dim BtnCancel : Set BtnCancel = SDB.UI.NewButton(Form)
BtnCancel.Caption = "&Cancel"
BtnCancel.Cancel = True
BtnCancel.ModalResult = 2
BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width -20
BtnCancel.Common.Top = ChkDebug.Common.Top +25
Dim BtnOk : Set BtnOk = SDB.UI.NewButton(Form)
BtnOk.Caption = "&Ok"
BtnOk.Default = True
BtnOk.ModalResult = 1
BtnOk.Common.Left = BtnCancel.Common.Left - BtnOk.Common.Width -10
BtnOk.Common.Top = BtnCancel.Common.Top
'show form
If Not (Form.ShowModal = 1) Then
Exit Sub
End If
'save settings
Directory = EdtDirectory.Text
FileMask = EdtFileMask.Text
FullPath = ChkFullPath.Checked
AlbumOnly = ChkAlbumOnly.Checked
UpOneLevel = ChkUpOneLevel.Checked
Debug = ChkDebug.Checked
Unicode = DrpUnicode.ItemIndex
OldPath = EdtOldPath.Text
NewPath = EdtNewPath.Text
ini.StringValue("BatchM3UCreator","Directory") = Directory
ini.StringValue("BatchM3UCreator","FileMask") = FileMask
ini.BoolValue("BatchM3UCreator","FullPath") = FullPath
ini.BoolValue("BatchM3UCreator","AlbumOnly") = AlbumOnly
ini.BoolValue("BatchM3UCreator","UpOneLevel") = UpOneLevel
ini.BoolValue("BatchM3UCreator","Debug") = Debug
ini.IntValue("BatchM3UCreator","Unicode") = Unicode
ini.StringValue("BatchM3UCreator","OldPath") = OldPath
ini.StringValue("BatchM3UCreator","NewPath") = NewPath
'calculate mode
Dim str : str = DrpMode.ItemText(DrpMode.ItemIndex)
Select Case UCase(Left(str,3))
Case "SEL"
prog.MaxValue = tot
fis = ""
Case "FIL"
Set list = Nothing
sql = "SELECT Count(DISTINCT Albums.ID) FROM Albums,Songs WHERE Albums.ID>0 AND Albums.Album!='' AND Albums.ID=Songs.IDAlbum"&fis
prog.MaxValue = SDB.Database.OpenSQL(sql).ValueByIndex(0)
Case Else
Set list = Nothing
fis = ""
End Select
'create logfile
If Debug Then
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")
If Right(loc,1) = "\" Then
loc = loc&"BatchM3UCreator.log"
Else
loc = loc&"\BatchM3UCreator.log"
End If
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Set logf = fso.CreateTextFile(loc,True,True)
Call logf.WriteLine(prog.Text)
End If
'loop through all albums creating playlist
Dim id,es
Dim errors : errors = ""
Dim ecount : ecount = 0
If list Is Nothing Then
If Debug Then
If fis = "" Then
Call logf.WriteLine("(All albums = "&prog.MaxValue&")")
Else
Call logf.WriteLine("(Albums in filter '"&fin&"' = "&prog.MaxValue&")")
End If
End If
If fis = "" Then
sql = "SELECT ID,Album FROM Albums WHERE ID>0 AND Album!='' ORDER BY Albums.Album"
Else
sql = "SELECT DISTINCT Albums.ID,Albums.Album FROM Albums,Songs WHERE Albums.ID>0 AND Albums.Album!='' AND Albums.ID=Songs.IDAlbum"&fis&" ORDER BY Albums.Album"
End If
Set iter = SDB.Database.OpenSQL(sql)
Do While Not iter.EOF
'update progress bar
Dim aid : aid = iter.ValueByIndex(0)
Dim alb : alb = iter.ValueByIndex(1)
prog.Increase
prog.Text = "BatchM3UCreator: Processing album "&prog.Value&"/"&prog.MaxValue&" ("&alb&")..."
SDB.ProcessMessages
'get album data
sql = "AND (Songs.IDAlbum="&aid&")"
Dim songs : Set songs = SDB.Database.QuerySongs(sql)
If Not (songs.EOF) Then
If Debug Then
Call logf.WriteLine("-"&prog.Value&":"&aid)
End If
Call CreateM3U(songs.Item.Album,es)
If Not (es = "") Then
ecount = ecount + 1
errors = errors&Chr(13)&es
End If
End If
'allow user to cancel
If prog.Terminate Then
Exit Sub
Else
iter.Next
End If
Loop
Else
If Debug Then
Call logf.WriteLine("(Selected albums = "&prog.MaxValue&")")
End If
For i = 0 To list.Albums.Count-1
Dim itm : Set itm = list.Albums.Item(i)
'update progress bar
prog.Increase
prog.Text = "BatchM3UCreator: Processing album '"&itm.Name&"' - "&prog.Value&"/"&prog.MaxValue&"..."
SDB.ProcessMessages
'get album data
If itm.ID > 0 Then
If Debug Then
Call logf.WriteLine("-"&prog.Value&":"&itm.ID)
End If
Call CreateM3U(itm,es)
If Not (es = "") Then
ecount = ecount + 1
errors = errors&Chr(13)&es
End If
End If
'allow user to cancel
If prog.Terminate Then
Exit Sub
End If
Next
End If
'save logfile
prog.Value = prog.MaxValue
prog.Text = "BatchM3UCreator: Finalising..."
SDB.ProcessMessages
If Debug Then
Call logf.WriteLine("<END>")
Call logf.Close()
End If
'report errors
If ecount > 0 Then
Call SDB.MessageBox("BatchM3UCreator: The following "&ecount&" files could not be created:"&Chr(13)&errors,mtError,Array(mbOk))
End If
End Sub
Sub BrowseDirectory()
Dim but : Set but = SDB.Objects("BatchM3UCreatorButton")
If Not (but Is Nothing) Then
Dim edt : Set edt = but.Common.TopParent.Common.ChildControl("Directory")
If Not (edt Is Nothing) Then
Dim str : str = SDB.SelectFolder(edt.Text,"Select root directory:")
If Not (str = "") Then
If Right(str,1) = "\" Then
edt.Text = str
Else
edt.Text = str&"\"
End If
End If
End If
End If
End Sub
Sub CreateM3U(album,error)
If Debug Then
Call logf.WriteLine("--(Starting)")
End If
Dim tot : tot = album.Tracks.Count
If tot < 1 then
If Debug Then
Call logf.WriteLine("--(Album contains no tracks)")
End If
error = "???"
Exit Sub
End If
'check for unicode
Dim uni : uni = False
Dim ext : ext = ".m3u"
Select Case Unicode
Case 1 'M3U
uni = True
Case 2 'M3U8
uni = True
ext = ".m3u8"
Case 3 'Mixed
If CheckUnicode(album) Then
uni = True
ext = ".m3u8"
End If
End Select
If Debug Then
If uni Then
Call logf.WriteLine("--(Saving in unicode)")
Else
Call logf.WriteLine("--(Saving in ASCII)")
End If
End If
'calculate playlist location
Dim loc : loc = album.Tracks.Item(0).Path
Dim pos : pos = InStrRev(loc,"\")
Dim rel : rel = Left(loc,pos)
If Directory = "" Then
If UpOneLevel Then
pos = InStrRev(Left(loc,pos-1),"\")
If pos > 0 Then
rel = Left(loc,pos)
End If
End If
Else
If Right(Directory,1) = "\" Then
rel = Directory
Else
rel = Directory&"\"
End If
End If
Dim del : del = Replace(FormatNumber(1.1,1),"1","")
Dim art : art = Replace(album.Artist.Name,"\","-")
Dim alb : alb = Replace(album.Name,"\","-")
Dim sec : sec = GetTime(album.AlbumLength/1000)
Dim dsc : dsc = 1
Dim sum : sum = 0
Dim ran : ran = 0
For pos = 0 To tot-1
Dim itm : Set itm = album.Tracks.Item(pos)
sum = sum+itm.Year
If itm.Rating > -1 Then
ran = ran+itm.Rating
End If
If itm.DiscNumber > dsc Then
dsc = itm.DiscNumber
End If
Next
Dim yea : yea = CStr(sum/tot)
sum = InStr(yea,del)
If sum > 1 Then
yea = Left(yea,sum-1)
End If
Dim ras : ras = CStr((ran/20)/tot)
ran = InStr(ras,del)
If ran > 1 Then
ras = Left(ras,ran-1)
End If
Dim arr : arr = Split(rel,"\")
Dim ubd : ubd = UBound(arr)
Dim pa1 : pa1 = ""
Dim pa2 : pa2 = ""
Dim pa3 : pa3 = ""
If ubd = 1 Then
pa1 = arr(1)
ElseIf ubd = 2 Then
pa1 = arr(2)
pa2 = arr(1)
ElseIf ubd > 2 Then
pa1 = arr(ubd-1)
pa2 = arr(ubd-2)
pa3 = arr(ubd-3)
End If
loc = FileMask
loc = Replace(loc,"<Artist>",art)
loc = Replace(loc,"<Album>",alb)
loc = Replace(loc,"<Year>",yea)
loc = Replace(loc,"<Tracks>",tot)
loc = Replace(loc,"<Length>",sec)
loc = Replace(loc,"<Rating>",ras)
loc = Replace(loc,"<Discs>",dsc)
loc = Replace(loc,"<Path1>",pa1)
loc = Replace(loc,"<Path2>",pa2)
loc = Replace(loc,"<Path3>",pa3)
loc = CorrectPath(rel&loc&ext,uni)
If Debug Then
Call logf.WriteLine("--"&loc)
End If
'check filename length
If (Len(loc) > 255) And (Debug) Then
Call logf.WriteLine("--(Filename is too long)")
End If
'check album folder exists
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(rel) Then
If Debug Then
Call logf.WriteLine("--(Creating folder)")
End If
Call GeneratePath(fso,rel)
End If
'backup any existing playlist
If fso.FileExists(loc) Then
Call fso.CopyFile(loc,loc&".bak",True)
If Debug Then
Call logf.WriteLine("--(Previous backed up)")
End If
End If
'create new playlist file
On Error Resume Next
Dim out : Set out = fso.CreateTextFile(loc,True,uni)
If (Err.Number <> 0) Or (out Is Nothing) Then
If Debug Then
Call logf.WriteLine("--(Could not create file)")
End If
error = loc
Err.Clear
Else
Call out.WriteLine("#EXTM3U")
Dim sql : sql = "AND (Songs.IDAlbum="&album.ID&") ORDER BY CAST(Songs.DiscNumber AS INTEGER), CAST(Songs.TrackNumber AS INTEGER)"
Dim iter : Set iter = SDB.Database.QuerySongs(sql)
While Not (iter.EOF)
Call AddTrack(iter.Item,rel,out,uni)
If Err.Number <> 0 Then
If Debug Then
Call logf.WriteLine("---(Error "&Err.Number&" adding: "&iter.item.Path)
End If
Err.Clear
End If
iter.Next
WEnd
out.Close
If Debug Then
Call logf.WriteLine("--(Complete)")
End If
error = ""
End If
On Error Goto 0
End Sub
Sub AddTrack(itm,rel,out,uni)
Dim InAlbum : InAlbum = False
If InStr(itm.Path,rel) = 1 Then
InAlbum = True
End If
If Not(AlbumOnly) Or InAlbum Then
If Debug Then
Call logf.WriteLine("---"&itm.Path)
End If
Dim lin : lin = "#EXTINF:"&Left(CStr(itm.SongLength),3)&","&itm.ArtistName&" - "&itm.Title
If uni Then
Call out.WriteLine(lin)
Else
Call out.WriteLine(SDB.toASCII(lin))
End If
If Err.Number <> 0 Then
Call out.WriteLine("#EXTINF:"&itm.ID&" ["&Err.Number&"]")
Err.Clear
End If
Dim loc : loc = ""
If FullPath Then
loc = itm.Path
Else
If InAlbum Then
loc = Replace(itm.Path,rel,"")
Else
loc = RelativePath(itm.Path,rel)
End If
End If
If OldPath = "" Then
If Not (NewPath = "") Then
loc = NewPath&loc
End If
Else
If Left(loc,Len(OldPath)) = OldPath Then
loc = NewPath&Mid(loc,Len(OldPath)+1)
End If
End If
If InStr(NewPath,"/") > 0 Then
loc = Replace(loc,"\","/")
End If
Call out.WriteLine(loc)
If Err.Number <> 0 Then
If uni Then
Call out.WriteLine("#"&loc&" ["&Err.Number&"]")
Else
Call out.WriteLine("#"&SDB.toASCII(loc)&" ["&Err.Number&"]")
End If
Err.Clear
End If
Else
If Debug Then
Call logf.WriteLine("---(Ignoring track: "&itm.Path&")")
End If
End If
End Sub
Function CorrectPath(loc,uni)
Dim fso : Set fso = SDB.Tools.FileSystem
Dim str : str = loc
If uni = False Then
str = Replace(SDB.toASCII(str),"?","_")
End If
Dim arr : arr = Split(str,"\")
Dim i : i = 0
CorrectPath = arr(i)
For i = 1 To UBound(arr)
CorrectPath = CorrectPath&"\"&fso.CorrectFilename(arr(i))
Next
End Function
Sub Install()
Dim inip : inip = SDB.ApplicationPath&"Scripts\Scripts.ini"
Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
If Not (inif Is Nothing) Then
inif.StringValue("BatchM3UCreator","Filename") = "BatchM3UCreator.vbs"
inif.StringValue("BatchM3UCreator","Procname") = "BatchM3UCreator"
inif.StringValue("BatchM3UCreator","Order") = "33"
inif.StringValue("BatchM3UCreator","DisplayName") = "Batch M3U Creator"
inif.StringValue("BatchM3UCreator","Description") = "Creates an M3U playlist for each album"
inif.StringValue("BatchM3UCreator","Language") = "VBScript"
inif.StringValue("BatchM3UCreator","ScriptType") = "0"
SDB.RefreshScriptItems
End If
End Sub
Function RelativePath(relp,path)
RelativePath = relp
Dim temp : temp = Left(path,InStrRev(path,"\"))
'check same folder
If InStr(relp,temp) = 1 Then
RelativePath = Mid(relp,Len(temp)+1)
Exit Function
End If
'check parent folders
If Left(temp,2) = "\\" Then
temp = Mid(temp,3)
End If
If Left(relp,2) = "\\" Then
relp = Mid(relp,3)
End If
Dim tp : tp = Left(temp,InStr(temp,"\"))
Dim tr : tr = Left(relp,InStr(relp,"\"))
If (UCase(tp) = UCase(tr)) Then
While (UCase(tp) = UCase(tr))
temp = Mid(temp,Len(tp)+1)
relp = Mid(relp,Len(tr)+1)
tp = Left(temp,InStr(temp,"\"))
tr = Left(relp,InStr(relp,"\"))
WEnd
RelativePath = ""
While (InStr(temp,"\") > 0)
RelativePath = RelativePath&"..\"
temp = Mid(temp,Len(tp)+1)
tp = Left(temp,InStr(temp,"\"))
WEnd
RelativePath = RelativePath&relp
End If
End Function
Function GeneratePath(fso,pFolderPath)
GeneratePath = False
If Not fso.FolderExists(pFolderPath) Then
If GeneratePath(fso,fso.GetParentFolderName(pFolderPath)) Then
GeneratePath = True
Call fso.CreateFolder(pFolderPath)
End If
Else
GeneratePath = True
End If
End Function
Function CheckUnicode(album)
CheckUnicode = True
If Not (album.Name = SDB.toASCII(album.Name)) Then
Exit Function
End If
If Not (album.Artist.Name = SDB.toASCII(album.Artist.Name)) Then
Exit Function
End If
Dim list : Set list = album.Tracks
Dim i : i = 0
For i = 0 To list.Count-1
Dim itm : Set itm = list.Item(i)
If Not (itm.Title = SDB.toASCII(itm.Title)) Then
Exit Function
End If
If Not (itm.Path = SDB.toASCII(itm.Path)) Then
Exit Function
End If
Next
CheckUnicode = False
End Function
Function GetTime(sec)
Dim min : min = 0
sec = Int(sec)
If sec < 0 Then
sec = sec+86400
End If
Do While sec > 59
sec = sec - 60
min = min + 1
Loop
If sec < 10 Then
GetTime = min&":0"&sec
Else
GetTime = min&":"&sec
End If
End Function