Batch M3U Creator 2.7 - Updated 23/09/2012

trixmoto · Post by **trixmoto** » 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!

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

trixmoto · Post by **trixmoto** » Mon Jul 17, 2006 9:18 am

New version (1.1) fixes the filenames of the playlists.

trixmoto · Post by **trixmoto** » Wed Jul 19, 2006 5:11 am

New version (1.2) includes a debug logfile mode.

trixmoto · Post by **trixmoto** » Wed Jul 19, 2006 5:13 am

New version (1.3) includes a FullPath mode, the default is to create relative filepaths.

Also if the artist/album have "\" in them, this is now corrected to "-" to avoid errors.

trixmoto · Post by **trixmoto** » Wed Jul 19, 2006 5:21 am

New version (1.4) fixes problem where the path is not always relative, so sometimes the full path must be used.

By the way, I am getting email feedback from the user who requested the script - I'm not just talking to myself!

Teknojnky · Post by **Teknojnky** » Wed Jul 19, 2006 8:35 am

psyXonova · Post by **psyXonova** » Thu Jul 20, 2006 6:50 am

trixmoto wrote:By the way, I am getting email feedback from the user who requested the script - I'm not just talking to myself!

Hmmm, this seems rather serious, not only you are talking to yourself, but you are trying to convince us (and yourself) that your are not talking to yourself.

Next thing we'll see is posting those ghost emails to convince us (and yourself) that your are not talking to yourself and that you dont have imaginery friends.

You might even create a new MM forums account and start posting to this thread as your imaginery friend, to convince us (and yourself) that your are not talking to yourself and that you dont have imaginery friends.

trixmoto · Post by **trixmoto** » Thu Jul 20, 2006 8:45 am

I wish my imaginary friend wasn't so critical!

Bex · Post by **Bex** » Thu Jul 20, 2006 8:53 am

psyXonova · Post by **psyXonova** » Thu Jul 20, 2006 12:56 pm

Yeah, i wish that too...

vphreeze · Post by **vphreeze** » Fri Aug 18, 2006 2:21 am

could this be modified to create playlists based on other values? specifically, i would like playlists based on Genre and my playlists placed in the root folder. my folders are arranged into Genre\Artist\Album\

the actual files are in the album folder

trixmoto · Post by **trixmoto** » Fri Aug 18, 2006 3:10 am

Yes this would be possible. I'll put it on my todo list, but it's a long list at the moment!

Guest · Post by **Guest** » Fri Aug 18, 2006 8:26 am

Would it be possible to make a modified version of this script where you can define your own path to where the playlists are saved, and where the location of the music files are.

My portable mp3player uses a M3U playlists and I'm having trouble making them. It would be great if I could use this scripts to create M3U playlists.

Thanks in advance,
Paul

trixmoto · Post by **trixmoto** » Fri Aug 18, 2006 9:42 am

It's on my list!

Guest · Post by **Guest** » Fri Aug 18, 2006 1:00 pm

Wonderful