The installer can be downloaded from my website!
![:)](./images/smilies/icon_smile.gif)
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