Recreate M3U 2.4 - Updated 25/10/2010

trixmoto · Post by **trixmoto** » Fri May 18, 2007 5:03 am

This is a new script which allows you to import M3U files even if the filenames in the playlist do not appear in your database. It uses a progressive searching method to try and find the same track even if it has been reorganised. This has been previously discussed here.

As per usual, the installer is available from my website. Let me know what you think!

Code: Select all

'
' MediaMonkey Script
'
' NAME: RecreateM3U 2.4
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 25/10/2010
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini 
'          Don't forget to remove comments (') and set the order appropriately 
'
' [RecreateM3U]
' FileName=RecreateM3U.vbs
' ProcName=RecreateM3U
' Order=100
' DisplayName=&Recreate M3U
' Description=Recreate broken M3U playlist
' Language=VBScript
' ScriptType=0 
'
' FIXES: Fixed "component named RecreateM3UList already exists" error
'        Added debug mode to log sql commands
'        Added options to include artist and album fields 
'        Added option to include fuzzy matching logic
'

Option Explicit
Dim Debug : Debug = False
Dim ShowMode : ShowMode = 1       'Show confirmation screen: 0=Never 1=Default 2=Always 3=Automatic
Dim ShowRows : ShowRows = 20      'Number of tracks on confirmation screen
Dim Playlist : Playlist = False   'Create a playlist?
Dim UseComms : UseComms = True    'Use comments as well?
Dim DefTrack : DefTrack = 0       'Select track: 0=First 1=Bitrate 2=DateAdded 3=PlayCounter 4=Rating
Dim NoneMode : NoneMode = 0       'Action if no matches: 0=Skip 1=Create 2=List
Dim CheckLib : CheckLib = False   'Check library for file path first?
Dim CheckArt : CheckArt = True    'Include artist name
Dim CheckAlb : CheckAlb = True    'Include album name
Dim UseFuzzy : UseFuzzy = False   'Use fuzzy matching logic?

Sub RecreateM3U
  'default settings
  Dim ini : Set ini = SDB.IniFile
  If ini.ValueExists("RecreateM3U","ShowMode") Then
    ShowMode = ini.IntValue("RecreateM3U","ShowMode")
  End If
  If ini.ValueExists("RecreateM3U","ShowRows") Then
    ShowRows = ini.IntValue("RecreateM3U","ShowRows")
  End If  
  If ini.ValueExists("RecreateM3U","Playlist") Then
    Playlist = ini.BoolValue("RecreateM3U","Playlist")
  End If  
  If ini.ValueExists("RecreateM3U","UseComms") Then
    UseComms = ini.BoolValue("RecreateM3U","UseComms")
  End If    
  If ini.ValueExists("RecreateM3U","DefTrack") Then
    DefTrack = ini.IntValue("RecreateM3U","DefTrack")
  End If    
  If ini.ValueExists("RecreateM3U","UseFuzzy") Then
    UseFuzzy = ini.BoolValue("RecreateM3U","UseFuzzy")
  End If    
  If ini.ValueExists("RecreateM3U","NoneMode") Then
    NoneMode = ini.IntValue("RecreateM3U","NoneMode")
  End If    
  If ini.ValueExists("RecreateM3U","CheckLib") Then
    CheckLib = ini.BoolValue("RecreateM3U","CheckLib")
  End If
  If ini.ValueExists("RecreateM3U","CheckArt") Then
    CheckArt = ini.BoolValue("RecreateM3U","CheckArt")
  End If      
  If ini.ValueExists("RecreateM3U","CheckAlb") Then
    CheckAlb = ini.BoolValue("RecreateM3U","CheckAlb")
  End If                

  '*******************************************************************'
  '* Form produced by MMVBS Form Creator (http://trixmoto.net/mmvbs) *'
  '*******************************************************************'

  Dim Form1 : Set Form1 = SDB.UI.NewForm
  Form1.BorderStyle = 3
  Form1.Caption = "Recreate M3U"
  Form1.FormPosition = 4
  Form1.StayOnTop = True
  Form1.Common.SetRect 0,0,445,270
  Form1.Common.ControlName = "RecreateM3UOpts"
  
  Dim Label3 : Set Label3 = SDB.UI.NewLabel(Form1)
  Label3.Common.SetRect 10,10,65,17
  Label3.Caption = "Playlist to be fixed:"

  Dim Edit1 : Set Edit1 = SDB.UI.NewEdit(Form1)
  Edit1.Common.SetRect 150,7,250,21
  Edit1.Common.ControlName = "Filename"
  If ini.ValueExists("RecreateM3U","LastFile") Then
    Edit1.Text = ini.StringValue("RecreateM3U","LastFile")
  End If    

  Dim Button3 : Set Button3 = SDB.UI.NewButton(Form1)
  Button3.Caption = "..."
  Button3.UseScript = Script.ScriptPath
  Button3.OnClickFunc = "BrowseClick"
  Button3.Common.SetRect 405,6,21,21
  Button3.Common.ControlName = "BrowseButt"  

  Dim Label1 : Set Label1 = SDB.UI.NewLabel(Form1)
  Label1.Common.SetRect 10,35,65,17
  Label1.Caption = "Show confirmation screen:"

  Dim DropDown1 : Set DropDown1 = SDB.UI.NewDropDown(Form1)
  DropDown1.AddItem("Never (skip if multiple)")
  DropDown1.AddItem("Default (show if multiple)")
  DropDown1.AddItem("Always show")
  DropDown1.AddItem("Never (select if multiple)")
  DropDown1.ItemIndex = ShowMode
  DropDown1.Style = 2
  DropDown1.Common.SetRect 150,32,160,21
  DropDown1.Common.ControlName = "ShowMode"

  Dim Label2 : Set Label2 = SDB.UI.NewLabel(Form1)
  Label2.Common.SetRect 10,60,65,17
  Label2.Caption = "Maximum rows on screen:"

  Dim SpinEdit1 : Set SpinEdit1 = SDB.UI.NewSpinEdit(Form1)
  SpinEdit1.MaxValue = 99
  SpinEdit1.MinValue = 1
  SpinEdit1.Value = ShowRows
  SpinEdit1.Common.SetRect 150,57,40,21
  SpinEdit1.Common.ControlName = "ShowRows"

  Dim Label4 : Set Label4 = SDB.UI.NewLabel(Form1)
  Label4.Common.SetRect 10,85,65,17
  Label4.Caption = "Create playlist in library?"

  Dim CheckBox1 : Set CheckBox1 = SDB.UI.NewCheckBox(Form1)
  CheckBox1.Common.SetRect 150,82,98,20
  CheckBox1.Common.ControlName = "Playlist"
  CheckBox1.Checked = Playlist

  Dim Label5 : Set Label5 = SDB.UI.NewLabel(Form1)
  Label5.Common.SetRect 10,110,65,17
  Label5.Caption = "Use comments as well?"

  Dim CheckBox2 : Set CheckBox2 = SDB.UI.NewCheckBox(Form1)
  CheckBox2.Common.SetRect 150,107,98,20
  CheckBox2.Common.ControlName = "UseComms"
  CheckBox2.Checked = UseComms

  Dim Label6 : Set Label6 = SDB.UI.NewLabel(Form1)
  Label6.Common.SetRect 10,135,65,17
  Label6.Caption = "Select default track by:"

  Dim DropDown2 : Set DropDown2 = SDB.UI.NewDropDown(Form1)
  DropDown2.AddItem("First in list")
  DropDown2.AddItem("Highest bitrate")
  DropDown2.AddItem("Latest added")
  DropDown2.AddItem("Most played")
  DropDown2.AddItem("Highest rated")
  DropDown2.ItemIndex = DefTrack
  DropDown2.Style = 2
  DropDown2.Common.SetRect 150,132,121,21
  DropDown2.Common.ControlName = "DefTrack"

  Dim Label8 : Set Label8 = SDB.UI.NewLabel(Form1)
  Label8.Common.SetRect 10,160,65,17
  Label8.Caption = "Action if no matches:"

  Dim DropDown3 : Set DropDown3 = SDB.UI.NewDropDown(Form1)
  DropDown3.AddItem("Skip track")
  DropDown3.AddItem("Create track")
  DropDown3.AddItem("Add to summary")
  DropDown3.ItemIndex = NoneMode
  DropDown3.Style = 2
  DropDown3.Common.SetRect 150,157,121,21
  DropDown3.Common.ControlName = "NoneMode"
  
  Dim Label9 : Set Label9 = SDB.UI.NewLabel(Form1)
  Label9.Common.SetRect 10,185,65,17
  Label9.Caption = "Check library for file path?"

  Dim CheckBox4 : Set CheckBox4 = SDB.UI.NewCheckBox(Form1)
  CheckBox4.Common.SetRect 150,182,98,20
  CheckBox4.Common.ControlName = "CheckLib"
  CheckBox4.Checked = CheckLib
  
  Dim Label7 : Set Label7 = SDB.UI.NewLabel(Form1)
  Label7.Common.SetRect 10,210,65,17
  Label7.Caption = "Use fuzzy matching logic?"

  Dim CheckBox3 : Set CheckBox3 = SDB.UI.NewCheckBox(Form1)
  CheckBox3.Common.SetRect 150,207,98,20
  CheckBox3.Common.ControlName = "UseFuzzy"
  CheckBox3.Checked = UseFuzzy
  
  Dim Panel : Set Panel = SDB.UI.NewPanel(Form1)
  Panel.Common.SetRect 330, 80, 95, 70    
  
  Dim PanLab1 : Set PanLab1 = SDB.UI.NewLabel(Panel)
  PanLab1.Common.SetRect 10, 5, 150, 20
  PanLab1.Caption = "Check fields:" 
  
  Dim PanChk1 : Set PanChk1 = SDB.UI.NewCheckbox(Panel)
  PanChk1.Common.SetRect 10, 23, 200, 20
  PanChk1.Caption = "Artist name"
  PanChk1.Checked = CheckArt  
  
  Dim PanChk2 : Set PanChk2 = SDB.UI.NewCheckbox(Panel)
  PanChk2.Common.SetRect 10, 41, 200, 20
  PanChk2.Caption = "Album name"
  PanChk2.Checked = CheckAlb    

  Dim Button1 : Set Button1 = SDB.UI.NewButton(Form1)
  Button1.Cancel = True
  Button1.Caption = "Cancel"
  Button1.ModalResult = 2
  Button1.Common.SetRect Form1.Common.Width-95,Form1.Common.Height-60,75,25
  Button1.Common.Anchors = 12

  Dim Button2 : Set Button2 = SDB.UI.NewButton(Form1)
  Button2.Default = True 
  Button2.Caption = "Ok"
  Button2.ModalResult = 1
  Button2.Common.SetRect Button1.Common.Left-85,Button1.Common.Top,75,25
  Button2.Common.Anchors = 12

  '*******************************************************************'
  '* End of form                              Richard Lewis (c) 2007 *'
  '*******************************************************************'
  
  If Form1.ShowModal = 2 Then
    Exit Sub
  End If
 
  'save settings
  ShowMode = Dropdown1.ItemIndex
  ini.IntValue("RecreateM3U","ShowMode") = ShowMode
  ShowRows = SpinEdit1.Value
  ini.IntValue("RecreateM3U","ShowRows") = ShowRows
  Playlist = Checkbox1.Checked
  ini.BoolValue("RecreateM3U","Playlist") = Playlist
  UseComms = Checkbox2.Checked
  ini.BoolValue("RecreateM3U","UseComms") = UseComms
  DefTrack = Dropdown2.ItemIndex
  ini.IntValue("RecreateM3U","DefTrack") = DefTrack	
  UseFuzzy = Checkbox3.Checked
  ini.BoolValue("RecreateM3U","UseFuzzy") = UseFuzzy
  NoneMode = Dropdown3.ItemIndex
  ini.IntValue("RecreateM3U","NoneMode") = NoneMode
  CheckLib = Checkbox4.Checked
  ini.BoolValue("RecreateM3U","CheckLib") = CheckLib
  CheckArt = PanChk1.Checked
  ini.BoolValue("RecreateM3U","CheckArt") = CheckArt
  CheckAlb = PanChk2.Checked
  ini.BoolValue("RecreateM3U","CheckAlb") = CheckAlb      
  
  'check new playlist
  Dim nam : nam = Left(Edit1.Text,Len(Edit1.Text)-4)&"_fixed.m3u"  
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(Edit1.Text) Then
    If fso.FileExists(nam) Then
      If Not (mrYes = SDB.MessageBox("RecreateM3U: This playlist has already been fixed, do you wish to overwrite?",mtError,Array(mbYes,mbNo))) Then
        Exit Sub
      End If
    End If
  Else
    Call SDB.MessageBox("RecreateM3U: This playlist does not exist!",mtError,Array(mbOk))
    Exit Sub
  End If  
  ini.StringValue("RecreateM3U","LastFile") = Edit1.Text  
  
  'read playlist
  Dim prog : Set prog = SDB.Progress  
  prog.Value = 0
  prog.MaxValue = 1
  prog.Text = "RecreateM3U: Reading playlist..."
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Dim m3u : Set m3u = fso.OpenTextFile(Edit1.Text,1,False,-2)
  Dim str : str = ""
  Dim com : com = ""
  While Not (m3u.AtEndOfStream)
    str = m3u.ReadLine
    If Left(str,1) = "#" Then 
      If Left(str,8) = "#EXTINF:" Then
        com = Mid(str,9)
      End If
    Else
      While dic.Exists(str)
        str = str&"*"
      WEnd
      Call dic.Add(str,com)
      com = ""
    End If
    prog.MaxValue = prog.MaxValue + 1
    prog.Value = prog.Value + 1
  WEnd
  Call m3u.Close()
  If dic.Count = 0 Then
    Call SDB.MessageBox("RecreateM3U: This playlist cannot be fixed because it is empty.",mtError,Array(mbOk))
    Exit Sub
  End If  
  
  'create debug logfile
  If Debug Then 
    Call clear()
  End If          
  
  'find tracks
  Dim i : i = 0
  Dim j : j = 0
  Dim arr : arr = dic.Keys
  Dim res : Set res = CreateObject("Scripting.Dictionary")
  prog.Text = "RecreateM3U: Processing tracks..."
  prog.MaxValue = dic.Count 
  For i = 0 To UBound(arr)
    prog.Value = i
    prog.Text = "RecreateM3U: Processing track "&(i+1)&"/"&(dic.Count)&"..."
    str = "#"&Replace(arr(i),"*","")
    com = dic.Item(arr(i))
    If Not (com = "") Then
      prog.Text = prog.Text&"'"&com&"'..."
    End If
    If UseComms Then 
      Dim c : c = Replace(com,".","_")
      c = Replace(c,"\","_")
      str = str&":||:"&c
    End If
    Call FindTrack(str)
    If (str = "~#EXIT#~") Or (prog.Terminate) Then
      Exit Sub
    End If
    If Left(str,1) = "#" Then
      If NoneMode = 1 Then
        Dim itm : Set itm = SDB.NewSongData
        If InStr(str,":||:") > 1 Then
          itm.Path = Mid(str,2,InStrRev(str,":||:")-2)
        Else
          itm.Path = Mid(str,2)
        End If
        Call itm.MetadataFromFilename()
        Call itm.UpdateDB()
      End If
    Else
      j = j + 1      
    End If   
    While res.Exists(str)
      str = str&"*"
    WEnd     
    Call res.Add(str,com)
  Next  
  
  'create MM playlist
  Dim cur,pnam,tmp,ply,par,sql
  If Playlist Then
    cur = 1
    pnam = Mid(nam,InStrRev(nam,"\")+1)
    pnam = Left(pnam,InStrRev(pnam,"_")-1)
    tmp = pnam
    Set ply = SDB.PlaylistByTitle(tmp)
    While Not (ply.Title = "")
      cur = cur + 1
      tmp = pnam&"_"&cur
      Set ply = SDB.PlaylistByTitle(tmp)
    WEnd 
    If SDB.MessageBox("RecreateM3U: Do you wish to create playlist '"&tmp&"'?",mtConfirmation,Array(mbYes,mbNo)) = mrYes Then
      Set ply = SDB.PlaylistByTitle("").CreateChildPlaylist(tmp)        
    Else
      Playlist = False
    End If
  End If
  
  'create no-match list
  If NoneMode = 2 Then
    Dim Form3 : Set Form3 = SDB.UI.NewForm
    Form3.BorderStyle = 2
    Form3.Caption = "Recreate M3U"
    Form3.FormPosition = 4
    Form3.StayOnTop = True
    Form3.Common.SetRect 0,0,590,350
    Set SDB.Objects("RecreateM3UForm") = Form3

    Dim WB : Set WB = SDB.UI.NewActiveX(Form3,"Shell.Explorer") 
    WB.Common.Align = 5
    WB.Common.ControlName = "WB" 
    Dim doc : Set doc = WB.Interf.Document

    Dim Foot : Set Foot = SDB.UI.NewPanel(Form3) 
    Foot.Common.Align = 2
    Foot.Common.Height = 35 

    Dim Btn : Set Btn = SDB.UI.NewButton(Foot) 
    Btn.Caption = SDB.Localize("&OK")  
    Btn.Default = True
    Btn.Common.SetRect Foot.Common.Width-95, 9, 85, 24 
    Btn.Common.Anchors = 12
    Btn.UseScript = Script.ScriptPath 
    Btn.OnClickFunc = "OkClick"  

    Dim sty : sty = False
    doc.write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"&vbcrlf 
    doc.write "<html>"&vbcrlf 
    doc.write "  <head>"&vbcrlf 
    doc.write "    <title>Recreate M3U</title>"&vbcrlf 
    doc.write "    <style type='text/css'>"&vbcrlf 
    doc.write "      body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}"&vbcrlf 
    doc.write "      H1{font-family:'Verdana',sans-serif; font-size:10pt; color:#AAAAAA; text-align:left}"&vbcrlf 
    doc.write "      P{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000;}"&vbcrlf 
    doc.write "      TH{font-family:'Verdana',sans-serif; font-size:9pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}"&vbcrlf 
    doc.write "      TD{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}"&vbcrlf 
    doc.write "      TR.dark{background-color:#EEEEEE}"&vbcrlf 
    doc.write "      TR.aleft TH{text-align:left}"&vbcrlf 
    doc.write "    </style>"&vbcrlf 
    doc.write "  </head>"&vbcrlf     
    doc.write "  <body>"&vbcrlf 
    doc.write "    <h1>Playlist successfully recreated as '"&nam&"'. "&j&" of "&dic.Count&" tracks were found ("&((j*100)\dic.Count)&"%). Tracks not found...</h1>"&vbcrlf
    doc.write "    <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">"&vbcrlf  
    doc.write "      <tr class=""aleft"">"&vbcrlf 
    doc.write "        <th>Comment</th>"&vbcrlf  
    doc.write "        <th>Filename</th>"&vbcrlf 
    doc.write "      </tr>"&vbcrlf 
  End If
      
  'create M3U playlist
  Set m3u = fso.CreateTextFile(nam,True,True)
  Call m3u.WriteLine("#EXTM3U")
  arr = res.Keys
  prog.Text = "RecreateM3U: Writing playlist..."  
  prog.MaxValue = res.Count
  For i = 0 To UBound(arr)
    prog.Value = i
    com = res.Item(arr(i))
    If Not (com = "") Then
      Call m3u.WriteLine("#EXTINF:"&com)
    End If    
    str = Replace(arr(i),"*","")
    If InStr(str,":||:") > 1 Then
      str = Left(str,InStrRev(str,":||:")-1)
    End If    
    Call m3u.WriteLine(str)
    If Left(str,1) = "#" Then
      If NoneMode = 2 Then
        If sty Then
          doc.write "      <tr class='Dark'>"&vbcrlf 
          sty = False
        Else
          doc.write "      <tr>"&vbcrlf 
          sty = True
        End If       
        doc.write "        <td>"&Mid(com,2)&" </td>"&vbcrlf 
        doc.write "        <td>"&Mid(str,2)&" </td>"&vbcrlf 
        doc.write "      </tr>"&vbcrlf 
      End If    
    Else
      If Playlist Then
        com = Mid(Replace(str,"'","''"),2)
        sql = "SELECT Id FROM Songs WHERE SongPath = '"&com&"'"
        If Debug Then 
          Call out("#"&sql)
        End If                
        Dim qit : Set qit = SDB.Database.OpenSQL(sql)
        If Not (qit.EOF) Then      
          Call ply.AddTrackById(qit.StringByIndex(0))
        End If
      End If
    End If
  Next
  Call m3u.Close()
  
  'confirmation
  prog.Value = prog.MaxValue
  str = "All"
  i = 100
  If Not (j = dic.Count) Then
    str = j&" of "&dic.Count
    i = (j*100)\dic.Count
  End If
  If (NoneMode = 2) And (i < 100) Then
    doc.write "    </table>"&vbcrlf 
    doc.write "  </body>"&vbcrlf 
    doc.write "</html>"&vbcrlf 
    doc.Close
    Form3.Common.Visible = True
  Else
    Call SDB.MessageBox("RecreateM3U: Playlist successfully recreated as '"&nam&"'."&Chr(13)&str&" tracks were found ("&i&"%).",mtInformation,Array(mbOk))
  End If
End Sub

Sub OkClick(Control)
  Dim Form : Set Form = SDB.Objects("RecreateM3UForm")
  Form.Common.ControlName = ""
  Form.Common.Visible = False
  Set SDB.Objects("RecreateM3UForm") = Nothing 
End Sub

Sub BrowseClick(Control)
  Dim edt : Set edt = Control.Common.TopParent.Common.ChildControl("Filename")
  Dim dlg : Set dlg = SDB.CommonDialog
  dlg.DefaultExt = ".m3u"
  dlg.Filter = "Playlist (*.m3u)|*.m3u|Textfile (*.txt)|*.txt"
  dlg.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly + cdlOFNNoChangeDir
  dlg.InitDir = edt.Text
  dlg.ShowOpen
  If (dlg.Ok = False) Or (dlg.FileName = "") Then 
    Exit Sub
  End If
  edt.Text = dlg.FileName  
End Sub

Sub FindTrack(str)
  'initialise
  UseComms = SDB.IniFile.BoolValue("RecreateM3U","UseComms")
  ShowMode = SDB.IniFile.IntValue("RecreateM3U","ShowMode")
  CheckLib = SDB.IniFile.BoolValue("RecreateM3U","CheckLib")
  CheckArt = SDB.IniFile.BoolValue("RecreateM3U","CheckArt")
  CheckAlb = SDB.IniFile.BoolValue("RecreateM3U","CheckAlb")
  UseFuzzy = SDB.IniFile.BoolValue("RecreateM3U","UseFuzzy")
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Dim tmp : tmp = ""
  Dim sql : sql = ""
  Dim c : c = ""
  Dim i : i = 0
  Dim j : j = InStrRev(str,"\")+1
  Dim k : k = InStrRev(str,".")-1
  If (k = 0) Or (k < j) Then
    k = Len(str)
  End If
  
  'check library
  Dim dit : Set dit = Nothing
  If CheckLib Then
    If InStr(str,":||:") > 1 Then
      c = Replace(Mid(str,3,InStrRev(str,":||:")-3),"'","''")
    Else
      c = Replace(Mid(str,3),"'","''")
    End If    
    sql = "SELECT Id FROM Songs WHERE SongPath = '"&c&"'"
    If Debug Then 
      Call out("#"&sql)
    End If                
    Dim qit : Set qit = SDB.Database.OpenSQL(sql)
    If Not (qit.EOF) Then      
      tmp = qit.StringByIndex(0)
      If ShowMode = 2 Then
        Call SelectOne(str,"*"&tmp)
      Else
        Set dit = SDB.Database.QuerySongs(" AND Songs.ID="&tmp)
        If Not dit.EOF Then 
          str = dit.Item.Path
        End If
      End If    
      Exit Sub
    End If
  End If  
  
  'list words
  For i = j To k
    c = Mid(str,i,1)
    If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÅÄÂÃÁÀÆËÊÉÈÏÎÍÌÖÔÕÓÒØÜÛÚÙÝÇÐÑß",UCase(c)) > 0 Then
      tmp = tmp&c
    Else
      If Not (tmp = "") Then
        If Suitable(tmp) Then
          dic.Item(tmp) = ""
        End If
        tmp = ""
      End If
    End If
  Next
  If Not (tmp = "") Then
    dic.Item(tmp) = ""
  End If
  If Not UseComms Then
    If dic.Count = 0 Then
      Exit Sub
    End If
  End If
  
  'use comments
  If UseComms Then
    tmp = ""
    j = InStrRev(str,":||:")+4
    k = Len(str)
    For i = j To k
      c = Mid(str,i,1)
      If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÅÄÂÃÁÀÆËÊÉÈÏÎÍÌÖÔÕÓÒØÜÛÚÙÝÇÐÑß",UCase(c)) > 0 Then
        tmp = tmp&c
      Else
        If Not (tmp = "") Then
          If Suitable(tmp) Then
            dic.Item(tmp) = ""
          End If
          tmp = ""
        End If
      End If
    Next
    If Not (tmp = "") Then
      dic.Item(tmp) = ""
    End If  
    If dic.Count = 0 Then
      Exit Sub
    End If
  End If
  
  'sort by length
  Dim a : a = dic.Keys
  Dim b : b = False
  Do
    b = True
    For i = 0 To UBound(a)-1
      If Len(a(i+1)) > Len(a(i)) Then
        b = False
        tmp = a(i)
        a(i) = a(i+1)
        a(i+1) = tmp
      End If
    Next
  Loop Until b 
  
  'add folder names
  Dim d : d = Split(str,"\")
  Call dic.RemoveAll()
  For i = UBound(d)-1 To 1 Step -1
    tmp = ""
    For j = 1 To Len(d(i))
      c = Mid(d(i),j,1)
      If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÅÄÂÃÁÀÆËÊÉÈÏÎÍÌÖÔÕÓÒØÜÛÚÙÝÇÐÑß",UCase(c)) > 0 Then
        tmp = tmp&c
      Else
        If Not (tmp = "") Then
          If Suitable(tmp) And NotInArray(tmp,a) Then
            dic.Item(tmp) = ""
          End if
          tmp = ""
        End If
      End If 
    Next
    If Not (tmp = "") Then
      dic.Item(tmp) = ""
    End If      
  Next
  tmp = Join(a," ")&" "&Join(dic.Keys," ")
  a = Split(tmp," ")
  
  'initial search 
  tmp = fixsql(a(0))
  sql = "SELECT DISTINCT Songs.ID FROM Songs"
  If CheckArt Then
    sql = sql&",Artists,ArtistsSongs"
  End IF
  If CheckAlb Then
    sql = sql&",Albums"
  End If
  sql = sql&" WHERE Songs.ID > 0"
  If CheckArt Then
    sql = sql&" AND Songs.ID = ArtistsSongs.IDSong AND ArtistsSongs.IDArtist = Artists.ID"
  End If
  If CheckAlb Then
    sql = sql&" AND Songs.IDAlbum = Albums.ID"
  End If
  sql = sql&" AND ("
  If CheckArt Then
    If UseFuzzy Then
      sql = sql&"SOUNDEX(Artists.Artist) = SOUNDEX('"&Replace(a(0),"'","''")&"') OR "
    End If    
    sql = sql&"Artists.Artist LIKE '%"&tmp&"%' OR "    
  End If
  If CheckAlb Then
    If UseFuzzy Then
      sql = sql&"SOUNDEX(Albums.Album) = SOUNDEX('"&Replace(a(0),"'","''")&"') OR "
    End If        
    sql = sql&"Albums.Album LIKE '%"&tmp&"%' OR "    
  End If 
  If UseFuzzy Then
    sql = sql&"SOUNDEX(Songs.SongTitle) = SOUNDEX('"&Replace(a(0),"'","''")&"') OR "
  End If      
  sql = sql&"Songs.SongTitle LIKE '%"&tmp&"%')"
  If Debug Then 
    Call out("#"&sql)
  End If                  
  Dim sit : Set sit = SDB.Database.OpenSQL(sql)
  i = 0
  tmp = ""
  While Not sit.EOF
    i = i + 1
    If tmp = "" Then
      tmp = sit.StringByIndex(0)
    Else
      tmp = tmp&","&sit.StringByIndex(0)
    End If
    sit.Next
  WEnd
  If i = 1 Then
    If ShowMode = 2 Then
      Call SelectOne(str,"*"&tmp)
    Else
      Set dit = SDB.Database.QuerySongs(" AND Songs.ID="&tmp)
      If Not dit.EOF Then 
        str = dit.Item.Path
      End If
    End If    
    Exit Sub
  End If
  If i = 0 Then
    Exit Sub
  End If  

  'progressive searches
  Dim pre : pre = ""
  For i = 1 To UBound(a)
    pre = sql
    Dim tmp2 : tmp2 = fixsql(a(i))
    sql = "SELECT DISTINCT Songs.ID FROM Songs"
    If CheckArt Then
      sql = sql&",Artists,ArtistsSongs"
    End If
    If CheckAlb Then
      sql = sql&",Albums"
    End If
    sql = sql&" WHERE Songs.ID IN ("&tmp&")"
    If CheckArt Then
      sql = sql&" AND Songs.ID = ArtistsSongs.IDSong AND ArtistsSongs.IDArtist = Artists.ID"
    End If
    If CheckAlb Then
      sql = sql&" AND Songs.IDAlbum = Albums.ID"
    End If
    sql = sql&" AND ("
    If CheckArt Then
      If UseFuzzy Then
        sql = sql&"SOUNDEX(Artists.Artist) = SOUNDEX('"&Replace(a(i),"'","''")&"') OR "
      End If        
      sql = sql&"Artists.Artist LIKE '%"&tmp2&"%' OR "
    End If
    If CheckAlb Then
      If UseFuzzy Then
        sql = sql&"SOUNDEX(Albums.Album) = SOUNDEX('"&Replace(a(i),"'","''")&"') OR "
      End If    
      sql = sql&"Albums.Album LIKE '%"&tmp2&"%' OR "
    End If
    If UseFuzzy Then
      sql = sql&"SOUNDEX(Songs.SongTitle) = SOUNDEX('"&Replace(a(i),"'","''")&"') OR "
    End If    
    sql = sql&"Songs.SongTitle LIKE '%"&tmp2&"%')"    
    If Debug Then 
      Call out("#"&sql)
    End If                    
    Set sit = SDB.Database.OpenSQL(sql)
    j = 0
    tmp = ""
    While Not sit.EOF
      j = j + 1
      If tmp = "" Then
        tmp = sit.StringByIndex(0)
      Else
        tmp = tmp&","&sit.StringByIndex(0)
      End If
      sit.Next
    WEnd
    If j = 1 Then
      If ShowMode = 2 Then
        Call SelectOne(str,"*"&tmp)
      Else
        Set dit = SDB.Database.QuerySongs(" AND Songs.ID="&tmp)
        If Not dit.EOF Then 
          str = dit.Item.Path
        End If   
      End If
      Exit Sub
    End If
    If j = 0 Then
      'try track number
      Dim all : all = tmp
      tmp = ""
      Call dic.RemoveAll()
      For k = InStrRev(str,"\")+1 To InStrRev(str,".")-1
        c = Mid(str,k,1)
        If InStr("0123456789",c) > 0 Then
          tmp = tmp&c
        Else
          If (Len(tmp) > 0) And (Len(tmp) < 4) Then
            dic.Item(tmp) = ""
          End If
          tmp = ""
        End If
      Next
      If Not (tmp = "") Then
        dic.Item(tmp) = ""
      End If
      If dic.Count > 0 Then
        a = dic.Keys
        If dic.Count > 1 Then
          Do
            b = True
            For k = 0 To UBound(a)-1
              If Len(a(k+1)) > Len(a(k)) Then
                b = False
                tmp = a(k)
                a(k) = a(k+1)
                a(k+1) = tmp
              End If
            Next
          Loop Until b       
        End If
        For k = 0 To UBound(a)
          sql = pre&" AND (CAST(TrackNumber AS INTEGER) = "&(Int(a(k)))&")"
          If Debug Then 
            Call out("#"&sql)
          End If                          
          Set sit = SDB.Database.OpenSQL(sql)
          j = 0
          While Not sit.EOF
            j = j + 1
            tmp = sit.StringByIndex(0)
            sit.Next
          WEnd
          If j = 1 Then
            If ShowMode = 2 Then
              Call SelectOne(str,"*"&tmp)
            Else
              Set dit = SDB.Database.QuerySongs(" AND Songs.ID="&tmp)
              If Not dit.EOF Then 
                str = dit.Item.Path
              End If                
            End If
            Exit Sub            
          End If        
        Next
      End If  
      Exit For
    End If
  Next 
  
  'possible results
  Call SelectOne(str,pre)  
End Sub

Sub SelectOne(str,pre)  
  If (str = "") Or (pre = "") Then
    Exit Sub
  End If
  ShowMode = SDB.IniFile.IntValue("RecreateM3U","ShowMode")
  If ShowMode = 0 Then
    Exit Sub
  End If    
  
  'list ids
  Dim tmp : tmp = ""
  Dim sit : Set sit = Nothing
  If Left(pre,1) = "*" Then
    tmp = Mid(pre,2)
  Else
    If Debug Then 
      Call out("#"&pre)
    End If                  
    Set sit = SDB.Database.OpenSQL(pre)
    While Not sit.EOF
      If tmp = "" Then
        tmp = sit.StringByIndex(0)
      Else
        tmp = tmp&","&sit.StringByIndex(0)
      End If
      sit.Next
    WEnd
  End If
  If (ShowMode < 2) And (InStr(tmp,",") = 0) Then
    Exit Sub
  End If
  
  'check rows
  ShowRows = SDB.IniFile.IntValue("RecreateM3U","ShowRows")
  Dim i : i = 0
  Dim l : Set l = SDB.NewSongList  
  Dim a : a = Split(tmp,",")
  If UBound(a)+1 > ShowRows Then
    Exit Sub
  End If

  '********************************************************************'
  '* Form produced by MMVBS Form Creator (http://trixmoto.net/mmvbs)  *'
  '********************************************************************'

  Dim Form1 : Set Form1 = SDB.UI.NewForm
  Form1.BorderStyle = 2
  Form1.Caption = "Recreate M3U"
  Form1.FormPosition = 4
  Form1.StayOnTop = True
  Form1.Common.ControlName = "RecreateM3UForm"
  Form1.Common.SetRect 0,0,590,150
  Form1.Common.MinWidth = 590
  Form1.Common.MinHeight = 200
  Call Script.RegisterEvent(Form1.Common,"OnResize","FormOnResize")
 
  Dim Label1 : Set Label1 = SDB.UI.NewLabel(Form1)
  Label1.Common.SetRect 10,10,65,17
  Label1.Caption = "Please select the track which you want to include for file..."

  Dim Label2 : Set Label2 = SDB.UI.NewLabel(Form1)
  Label2.Common.SetRect 10,35,65,17
  If InStr(str,":||:") > 1 Then
    Label2.Caption = Mid(str,2,InStrRev(str,":||:")-2)
  Else
    Label2.Caption = Mid(str,2)
  End If  

  Dim Label3 : Set Label3 = SDB.UI.NewLabel(Form1)
  Label3.Common.SetRect 10,60,65,17
  Label3.Caption = "Title"
 
  Dim Label4 : Set Label4 = SDB.UI.NewLabel(Form1)
  Label4.Common.SetRect 180,60,65,17
  Label4.Caption = "Artist"

  Dim Label5 : Set Label5 = SDB.UI.NewLabel(Form1)
  Label5.Common.SetRect 305,60,65,17
  Label5.Caption = "Album"

  Dim ini : Set ini = SDB.IniFile
  Dim ind : ind = 42
  If ini.ValueExists("RecreateM3U","LastOther") Then
    ind = ini.IntValue("RecreateM3U","LastOther")
  End If
  Dim DropDown1 : Set DropDown1 = SDB.UI.NewDropDown(Form1)
  DropDown1.AddItem("Author")
  DropDown1.AddItem("Band")
  DropDown1.AddItem("Bitrate")
  DropDown1.AddItem("BPM")
  DropDown1.AddItem("Channels")  
  DropDown1.AddItem("Comment")
  DropDown1.AddItem("Conductor")
  DropDown1.AddItem("Custom1")
  DropDown1.AddItem("Custom2")
  DropDown1.AddItem("Custom3")
  DropDown1.AddItem("Custom4")
  DropDown1.AddItem("Custom5")  
  DropDown1.AddItem("DateAdded")
  DropDown1.AddItem("DiscNumber")
  DropDown1.AddItem("DiscNumberStr")  
  DropDown1.AddItem("Encoder")
  DropDown1.AddItem("FileLength")
  DropDown1.AddItem("FileModified")
  DropDown1.AddItem("Genre")
  DropDown1.AddItem("Grouping")
  DropDown1.AddItem("InvolvedPeople")
  DropDown1.AddItem("ISRC")
  DropDown1.AddItem("LastPlayed")
  DropDown1.AddItem("Lyricist")
  DropDown1.AddItem("Lyrics")
  DropDown1.AddItem("Mood")
  DropDown1.AddItem("MusicComposer")
  DropDown1.AddItem("Occasion")
  DropDown1.AddItem("OriginalArtist")
  DropDown1.AddItem("OriginalLyricist")
  DropDown1.AddItem("OriginalTitle")
  DropDown1.AddItem("OriginalYear")
  DropDown1.AddItem("Path")
  DropDown1.AddItem("PlayCounter")
  DropDown1.AddItem("Publisher")
  DropDown1.AddItem("Quality")
  DropDown1.AddItem("Rating")
  DropDown1.AddItem("RatingString")
  DropDown1.AddItem("SampleRate")
  DropDown1.AddItem("SongLength")
  DropDown1.AddItem("SongLengthString")
  DropDown1.AddItem("Tempo")
  DropDown1.AddItem("TrackOrder")
  DropDown1.AddItem("TrackOrderStr")  
  DropDown1.AddItem("VBR")
  DropDown1.AddItem("Year")
  DropDown1.ItemIndex = ind
  DropDown1.Style = 2
  DropDown1.UseScript = Script.ScriptPath
  DropDown1.OnSelectFunc = "FillOther"
  DropDown1.Common.SetRect 430,57,120,21
  DropDown1.Common.Anchors = 6
  
  'show choices
  Dim val : val = 0
  ind = 0
  For i = 0 To UBound(a)
    Set sit = SDB.Database.QuerySongs(" AND Songs.ID="&a(i))
    If Not sit.EOF Then
    
      Dim Edit1 : Set Edit1 = SDB.UI.NewEdit(Form1)
      Edit1.Common.SetRect 10,(i*25)+85,165,21
      Edit1.Text = sit.Item.Title

      Dim Edit2 : Set Edit2 = SDB.UI.NewEdit(Form1)
      Edit2.Common.SetRect 180,(i*25)+85,120,21
      Edit2.Text = sit.Item.ArtistName

      Dim Edit3 : Set Edit3 = SDB.UI.NewEdit(Form1)
      Edit3.Common.SetRect 305,(i*25)+85,120,21
      Edit3.Text = sit.Item.AlbumName

      Dim Edit4 : Set Edit4 = SDB.UI.NewEdit(Form1)
      Edit4.Common.SetRect 430,(i*25)+85,120,21
      Edit4.Common.ControlName = "Other"&i
      Execute("Edit4.Text = sit.Item."&DropDown1.Text)
  
      Dim RadioButton1 : Set RadioButton1 = SDB.UI.NewRadioButton(Form1)
      RadioButton1.Common.SetRect 555,(i*25)+86,20,20  
      RadioButton1.Common.ControlName = "Radio"&i
      RadioButton1.Common.Anchors = 6
      
      Select Case DefTrack
        Case 1
          If sit.Item.Bitrate > val Then
            val = sit.Item.Bitrate
            ind = i
          End If
        Case 2
          If sit.Item.DateAdded > val Then
            val = sit.Item.DateAdded
            ind = i
          End If
        Case 3
          If sit.Item.PlayCounter > val Then
            val = sit.Item.PlayCounter
            ind = i
          End If
        Case 4
          If sit.Item.Rating > val Then
            val = sit.Item.Rating
            ind = i
          End If          
      End Select                  
      
      Form1.Common.Height = Form1.Common.Height + 25
      Call l.Add(sit.Item)
    End If
  Next
  
  If ShowMode = 3 Then
    str = l.Item(ind).Path
    Call Script.UnRegisterEvents(Form1.Common)
    Exit Sub
  End If
  
  Form1.Common.ChildControl("Radio"&ind).Checked = True
  Set SDB.Objects("RecreateM3USongList") = l  

  Dim Button1 : Set Button1 = SDB.UI.NewButton(Form1)
  Button1.Cancel = True
  Button1.Caption = "Exit"
  Button1.ModalResult = 3
  Button1.Common.SetRect Form1.Common.Width-95,Form1.Common.Height-60,75,25
  Button1.Common.Anchors = 12

  Dim Button2 : Set Button2 = SDB.UI.NewButton(Form1)
  Button2.Caption = "Skip"
  Button2.ModalResult = 2
  Button2.Common.SetRect Button1.Common.Left-85,Button1.Common.Top,75,25
  Button2.Common.Anchors = 12
  
  Dim Button3 : Set Button3 = SDB.UI.NewButton(Form1)
  Button3.Caption = "Ok"
  Button3.Default = True  
  Button3.ModalResult = 1
  Button3.Common.SetRect Button2.Common.Left-85,Button2.Common.Top,75,25  
  Button3.Common.Anchors = 12

  '*******************************************************************'
  '* End of form                              Richard Lewis (c) 2007 *'
  '*******************************************************************'
  
  Select Case Form1.ShowModal
    Case 1 'ok
      For i = 0 To l.Count-1
        Dim rad : Set rad = Form1.Common.ChildControl("Radio"&i)
        If Not (rad Is Nothing) Then
          If rad.Checked Then
            str = l.Item(i).Path
            Exit For
          End If
        End If
      Next
    Case 2 'skip
      'do nothing
    Case 3 'cancel
      str = "~#EXIT#~"
  End Select
  ini.IntValue("RecreateM3U","LastOther") = DropDown1.ItemIndex
  Call Script.UnRegisterEvents(Form1.Common)
End Sub

Sub FormOnResize(Control) 
  Dim list : Set list = SDB.Objects("RecreateM3USongList")
  If Not (list Is Nothing) Then
    Dim i : i = 0
    For i = 0 To list.Count-1
      Dim edt : Set edt = Control.Common.TopParent.Common.ChildControl("Other"&i)
      If Not (edt Is Nothing) Then
        Dim rad : Set rad = Control.Common.TopParent.Common.ChildControl("Radio"&i)
        If Not (rad Is Nothing) Then
          edt.Common.Width = rad.Common.Left-edt.Common.Left-5
        End If
      End If
    Next
  End If
End Sub

Sub FillOther(Control)
  Dim list : Set list = SDB.Objects("RecreateM3USongList")
  If Not (list Is Nothing) Then
    Dim i : i = 0
    For i = 0 To list.Count-1
      Dim edt : Set edt = Control.Common.TopParent.Common.ChildControl("Other"&i)
      If Not (edt Is Nothing) Then
        Execute("edt.Text = list.Item(i)."&Control.Text)
      End If
    Next
  End If
End Sub

Function NotInArray(s,a)
  NotInArray = False
  Dim i : i = 0
  For i = LBound(a) To UBound(a)    
    If a(i) = s Then
      Exit Function
    End If
  Next
  NotInArray = True
End Function

Function Suitable(s)
  Suitable = False
  If Len(s) = 1 Then
    Exit Function
  End If
  If IsNumeric(s) Then 
    Exit Function
  End if
  Dim a : a = Split(SDB.IniFile.StringValue("Options","IgnoreTHEStrings"),",")
  If Not (NotInArray(s,a)) Then
    Exit Function
  End If
  Suitable = True
End Function

Function fixsql(name) 
  fixsql = Replace(name,"'","''")
  fixsql = Replace(fixsql,"@","@@")
  fixsql = Replace(fixsql,"_","@_")
  fixsql = Replace(fixsql,"%","@%")    
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("RecreateM3U","Filename") = "RecreateM3U.vbs"
    inif.StringValue("RecreateM3U","Procname") = "RecreateM3U"
    inif.StringValue("RecreateM3U","Order") = "100"
    inif.StringValue("RecreateM3U","DisplayName") = "Recreate M3U"
    inif.StringValue("RecreateM3U","Description") = "Recreate broken M3U playlist"
    inif.StringValue("RecreateM3U","Language") = "VBScript"
    inif.StringValue("RecreateM3U","ScriptType") = "0"
    SDB.RefreshScriptItems
  End If
End Sub

Sub clear()
  Dim wsh : Set wsh = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")
  If Right(loc,1) = "\" Then
    loc = loc&"RecreateM3U.log"
  Else
    loc = loc&"\RecreateM3U.log"
  End If
  Dim logf : Set logf = fso.CreateTextFile(loc,True)
  logf.Close
End Sub

Sub out(txt)
  Dim wsh : Set wsh = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")
  If Right(loc,1) = "\" Then
    loc = loc&"RecreateM3U.log"
  Else
    loc = loc&"\RecreateM3U.log"
  End If  
  Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
  logf.WriteLine(Time&" "&SDB.ToAscii(txt))
  logf.Close
End Sub

mattisse · Post by **mattisse** » Fri May 18, 2007 10:38 am

Nice, a first step towards portable playlists in MM

At first I got some error messages (Runtime error 5 -Invalid procedure or argument with the 'Mid' function in lines 134 and 251). But after offsetting the starting position by +1 in those 2 function calls, the script ran smoothly.

The matching rate was pretty impressive. Only if the were several matches the script couldn't decide on one and didn't match anything at all

But I really like the concept and am looking forward to how it develops.

trixmoto · Post by **trixmoto** » Fri May 18, 2007 11:06 am

I never considered relative links, sorry - I'll fix this in the next version.

Maybe a confirmation screen is needed so you can select which of the multiple tracks you want to use?

mm_user2k6 · Post by **mm_user2k6** » Fri May 18, 2007 3:37 pm

I got a similar error to:

At first I got some error messages (Runtime error 5 -Invalid procedure or argument with the 'Mid' function in lines 134 and 251). But after offsetting the starting position by +1 in those 2 function calls, the script ran smoothly.

How do I fix?

Line 134 currently reads:

Code: Select all

    c = Mid(str,i,1)

What should it be?

Also, some M3U files don't have "#EXTM3U" at beginning, this cause error:

Code: Select all

RecreateM3U: This playlist cannot be fixed because it is empty.

But this error is reolved simply by adding #EXTM3U to top of playlist.

mattisse · Post by **mattisse** » Fri May 18, 2007 3:51 pm

mm_user2k6 wrote: How do I fix?

Line 134 currently reads:
Code: Select all
    c = Mid(str,i,1)
.

Try this code

Code: Select all

c = Mid(str,i+1,1)

That should fix the problem.

trixmoto · Post by **trixmoto** » Fri May 18, 2007 4:44 pm

mattisse's temporary fix should resolve this for you until I can release a proper fix.

The specification states that all M3U playlists should start with "#EXTM3U". I won't be strict about this in the next version though.

Teknojnky · Post by **Teknojnky** » Fri May 18, 2007 4:52 pm

I think one of the other things people wanted to use a script like this for is importing web top 10 lists or other playlists where they are not in a m3u format.

Like copy and paste this or this list of tracks and import it easily into MM using match tracks in your library.

So, perhaps instead of a 'recreate m3u' script, more like a 'recreate generic playlist' script.

trixmoto · Post by **trixmoto** » Fri May 18, 2007 5:54 pm

Well that's something a little different. This script is designed for broken playlists of this particular format (M3U) to give the best possible results. A more generic script could use a similar algorithm as it's proving pretty effective.

mm_user2k6 · Post by **mm_user2k6** » Fri May 18, 2007 10:56 pm

Any idea what is causing this error, when trying to run script (after selecting M3U file)?

Code: Select all

Error #457
This key is already associated with an element of this collection
Line: 63, Column: 8

trixmoto · Post by **trixmoto** » Sun May 20, 2007 5:31 am

It means you've got the same track twice in the playlist with exactly the same path. Another situation I hadn't considered which I think is going to be quite hard to fix. For now to get the script to work I think you'll have to comment out the second reference. I'll try to get this resolved for the next version though.

trixmoto · Post by **trixmoto** » Wed May 23, 2007 9:40 am

New version (1.1) is now available from my website. Changes include...

- Fixed errors with paths which don't include any folders
- Fixed playlists considered empty if no header ("#EXTM3U")
- Fixed errors with paths which appear multiple times in a playlist
- Added confirmation screen if a single track cannot be found

Code: Select all

'
' MediaMonkey Script
'
' NAME: RecreateM3U 1.1
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 23/05/2007
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini 
'          Don't forget to remove comments (') and set the order appropriately 
'
' FIXES: Fixed errors with paths which don't include any folders
'        Fixed playlists considered empty if no header ("#EXTM3U")
'        Fixed errors with paths which appear multiple times in a playlist
'        Added confirmation screen if a single track cannot be found
'
' [RecreateM3U]
' FileName=RecreateM3U.vbs
' ProcName=RecreateM3U
' Order=100
' DisplayName=&Recreate M3U
' Description=Recreate broken M3U playlist
' Language=VBScript
' ScriptType=0 
'

Option Explicit

Sub RecreateM3U
  'select playlist
  Dim dlg : Set dlg = SDB.CommonDialog
  dlg.DefaultExt = ".m3u"
  dlg.Filter = "Playlist (*.m3u)|*.m3u"
  dlg.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly + cdlOFNNoChangeDir
  dlg.InitDir = SDB.IniFile.StringValue("Scripts","RecreateM3UFile")
  dlg.ShowOpen
  If (dlg.Ok = False) Or (dlg.FileName = "") Then 
    Exit Sub
  End If
  SDB.IniFile.StringValue("Scripts","RecreateM3UFile") = dlg.FileName
  
  'check new playlist
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim nam : nam = Left(dlg.FileName,Len(dlg.FileName)-4)&"_fixed.m3u"  
  If fso.FileExists(nam) Then
    If Not (mrYes = SDB.MessageBox("RecreateM3U: This playlist has already been fixed, do you wish to overwrite?",mtError,Array(mbYes,mbNo))) Then
      Exit Sub
    End If
  End If  
  
  'read playlist
  Dim prog : Set prog = SDB.Progress  
  prog.Value = 0
  prog.MaxValue = 1
  prog.Text = "RecreateM3U: Reading playlist..."
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Dim m3u : Set m3u = fso.OpenTextFile(dlg.FileName,1,False)
  Dim str : str = ""
  Dim com : com = ""
  While Not (m3u.AtEndOfStream)
    str = m3u.ReadLine
    If Left(str,1) = "#" Then 
      If Left(str,8) = "#EXTINF:" Then
        com = Mid(str,9)
      End If
    Else
      While dic.Exists(str)
        str = str&"*"
      WEnd
      Call dic.Add(str,com)
      com = ""
    End If
    prog.MaxValue = prog.MaxValue + 1
    prog.Value = prog.Value + 1
  WEnd
  m3u.Close
  If dic.Count = 0 Then
    Call SDB.MessageBox("RecreateM3U: This playlist cannot be fixed because it is empty.",mtError,Array(mbOk))
    Exit Sub
  End If  
  
  'find tracks
  Dim i : i = 0
  Dim j : j = 0
  Dim arr : arr = dic.Keys
  Dim res : Set res = CreateObject("Scripting.Dictionary")
  prog.Text = "RecreateM3U: Processing tracks..."
  prog.MaxValue = dic.Count 
  For i = 0 To UBound(arr)
    prog.Value = i
    prog.Text = "RecreateM3U: Processing track "&(i+1)&"/"&(dic.Count)&"..."
    str = "#"&Replace(arr(i),"*","")
    com = dic.Item(arr(i))
    If Not (com = "") Then
      prog.Text = prog.Text&"'"&com&"'..."
    End If
    Call FindTrack(str)
    If Not (Left(str,1) = "#") Then
      j = j + 1
    End If
    While res.Exists(str)
      str = str&"*"
    WEnd    
    Call res.Add(str,com)
  Next  
      
  'create playlist
  Set m3u = fso.CreateTextFile(nam,True)
  m3u.WriteLine "#EXTM3U"
  arr = res.Keys
  prog.Text = "RecreateM3U: Writing playlist..."  
  prog.MaxValue = res.Count
  For i = 0 To UBound(arr)
    prog.Value = i
    com = res.Item(arr(i))
    If Not (com = "") Then
      m3u.WriteLine "#EXTINF:"&com
    End If    
    m3u.WriteLine Replace(arr(i),"*","")
  Next
  m3u.Close
  
  'confirmation
  prog.Value = prog.MaxValue
  str = "All"
  i = 100
  If Not (j = dic.Count) Then
    str = j&" of "&dic.Count
    i = (j*100)\dic.Count
  End If
  Call SDB.MessageBox("RecreateM3U: Playlist successfully recreated as '"&nam&"'."&Chr(13)&str&" tracks were found ("&i&"%).",mtInformation,Array(mbOk))
End Sub

Sub FindTrack(str)
  'list words
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Dim tmp : tmp = ""
  Dim i : i = 0
  Dim j : j = 0
  Dim c : c = ""
  
  For i = InStrRev(str,"\")+1 To InStrRev(str,".")-1
    c = Mid(str,i,1)
    If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789",UCase(c)) > 0 Then
      tmp = tmp&c
    Else
      If Not (tmp = "") Then
        If Suitable(tmp) Then
          dic.Item(tmp) = ""
        End If
        tmp = ""
      End If
    End If
  Next
  If Not (tmp = "") Then
    dic.Item(tmp) = ""
  End If  
  If dic.Count = 0 Then
    Exit Sub
  End If
  
  'sort by length
  Dim a : a = dic.Keys
  Dim b : b = False
  Do
    b = True
    For i = 0 To UBound(a)-1
      If Len(a(i+1)) > Len(a(i)) Then
        b = False
        tmp = a(i)
        a(i) = a(i+1)
        a(i+1) = tmp
      End If
    Next
  Loop Until b 
  
  'add folder names
  Dim d : d = Split(str,"\")
  Call dic.RemoveAll()
  For i = UBound(d)-1 To 1 Step -1
    tmp = ""
    For j = 1 To Len(d(i))
      c = Mid(d(i),j,1)
      If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789",UCase(c)) > 0 Then
        tmp = tmp&c
      Else
        If Not (tmp = "") Then
          If Suitable(tmp) And NotInArray(tmp,a) Then
            dic.Item(tmp) = ""
          End if
          tmp = ""
        End If
      End If 
    Next
    If Not (tmp = "") Then
      dic.Item(tmp) = ""
    End If      
  Next
  tmp = Join(a," ")&" "&Join(dic.Keys," ")
  a = Split(tmp," ")
  
  'initial search 
  Dim sql : sql = "SELECT Songs.ID FROM (Songs INNER JOIN Albums ON Songs.IDAlbum = Albums.ID) INNER JOIN Artists ON Albums.IDArtist = Artists.ID"
  sql = sql&" WHERE Artists.Artist LIKE '%"&a(0)&"%' OR Albums.Album LIKE '%"&a(0)&"%' OR Songs.SongTitle LIKE '%"&a(0)&"%'"  
  Dim sit : Set sit = SDB.Database.OpenSQL(sql)
  Dim dit : Set dit = Nothing
  i = 0
  tmp = ""
  While Not sit.EOF
    i = i + 1
    If tmp = "" Then
      tmp = sit.StringByIndex(0)
    Else
      tmp = tmp&","&sit.StringByIndex(0)
    End If
    sit.Next
  WEnd
  If i = 1 Then
    Set dit = SDB.Database.QuerySongs(" AND Songs.ID="&tmp)
    If Not dit.EOF Then 
      str = dit.Item.Path
      Exit Sub
    End If    
  End If
  If i = 0 Then
    Exit Sub
  End If  

  'progressive searches
  Dim pre : pre = ""
  For i = 1 To UBound(a)
    pre = sql
    sql = "SELECT Songs.ID FROM (Songs INNER JOIN Albums ON Songs.IDAlbum = Albums.ID) INNER JOIN Artists ON Albums.IDArtist = Artists.ID"
    sql = sql&" WHERE Songs.ID IN ("&tmp&") AND (Artists.Artist LIKE '%"&a(i)&"%' OR Albums.Album LIKE '%"&a(i)&"%' OR Songs.SongTitle LIKE '%"&a(i)&"%')"
    Set sit = SDB.Database.OpenSQL(sql)
    j = 0
    tmp = ""
    While Not sit.EOF
      j = j + 1
      If tmp = "" Then
        tmp = sit.StringByIndex(0)
      Else
        tmp = tmp&","&sit.StringByIndex(0)
      End If
      sit.Next
    WEnd
    If j = 1 Then
      Set dit = SDB.Database.QuerySongs(" AND Songs.ID="&tmp)
      If Not dit.EOF Then 
        str = dit.Item.Path
        Exit Sub
      End If    
    End If
    If j = 0 Then
      'try track number
      Dim k : k = 0
      Dim all : all = tmp
      tmp = ""
      Call dic.RemoveAll()
      For k = InStrRev(str,"\")+1 To InStrRev(str,".")-1
        c = Mid(str,k,1)
        If InStr("0123456789",c) > 0 Then
          tmp = tmp&c
        Else
          If (Len(tmp) > 0) And (Len(tmp) < 4) Then
            dic.Item(tmp) = ""
          End If
          tmp = ""
        End If
      Next
      If Not (tmp = "") Then
        dic.Item(tmp) = ""
      End If
      If dic.Count > 0 Then
        a = dic.Keys
        If dic.Count > 1 Then
          Do
            b = True
            For k = 0 To UBound(a)-1
              If Len(a(k+1)) > Len(a(k)) Then
                b = False
                tmp = a(k)
                a(k) = a(k+1)
                a(k+1) = tmp
              End If
            Next
          Loop Until b       
        End If
        For k = 0 To UBound(a)
          sql = pre&" AND (Songs.SongOrder = "&(Int(a(k))-1)&")"
          Set sit = SDB.Database.OpenSQL(sql)
          j = 0
          While Not sit.EOF
            j = j + 1
            tmp = sit.StringByIndex(0)
            sit.Next
          WEnd
          If j = 1 Then
            Set dit = SDB.Database.QuerySongs(" AND Songs.ID="&tmp)
            If Not dit.EOF Then 
              str = dit.Item.Path
              Exit Sub
            End If    
          End If        
        Next
      End If  
      Call SelectOne(str,pre)
      Exit Sub
    End If    
  Next
End Sub

Sub SelectOne(str,pre)
  'list ids
  Dim sit : Set sit = SDB.Database.OpenSQL(pre)
  Dim tmp : tmp = ""
  While Not sit.EOF
    If tmp = "" Then
      tmp = sit.StringByIndex(0)
    Else
      tmp = tmp&","&sit.StringByIndex(0)
    End If
    sit.Next
  WEnd
  If InStr(tmp,",") = 0 Then
    Exit Sub
  End If

  '********************************************************************'
  '* Form produced by MMVBS Form Creator (http://trixmoto.net/mmvbs3) *'
  '********************************************************************'

  Dim Form1 : Set Form1 = SDB.UI.NewForm
  Form1.BorderStyle = 3
  Form1.Caption = "Recreate M3U"
  Form1.FormPosition = 4
  Form1.StayOnTop = True
  Form1.Common.ControlName = "RecreateM3UForm"
  Form1.Common.SetRect 0,0,580,150
 
  Dim Label1 : Set Label1 = SDB.UI.NewLabel(Form1)
  Label1.Common.SetRect 10,10,65,17
  Label1.Caption = "Please select the track which you want to include..."

  Dim Label2 : Set Label2 = SDB.UI.NewLabel(Form1)
  Label2.Common.SetRect 10,35,65,17
  Label2.Caption = "Original filename: "&Mid(str,2)

  Dim Label3 : Set Label3 = SDB.UI.NewLabel(Form1)
  Label3.Common.SetRect 10,60,65,17
  Label3.Caption = "Title"
 
  Dim Label4 : Set Label4 = SDB.UI.NewLabel(Form1)
  Label4.Common.SetRect 180,60,65,17
  Label4.Caption = "Artist"

  Dim Label5 : Set Label5 = SDB.UI.NewLabel(Form1)
  Label5.Common.SetRect 305,60,65,17
  Label5.Caption = "Album"

  Dim DropDown1 : Set DropDown1 = SDB.UI.NewDropDown(Form1)
  DropDown1.AddItem("Author")
  DropDown1.AddItem("Band")
  DropDown1.AddItem("Bitrate")
  DropDown1.AddItem("BPM")
  DropDown1.AddItem("Comment")
  DropDown1.AddItem("Conductor")
  DropDown1.AddItem("Custom1")
  DropDown1.AddItem("Custom2")
  DropDown1.AddItem("Custom3")
  DropDown1.AddItem("DateAdded")
  DropDown1.AddItem("Encoder")
  DropDown1.AddItem("FileLength")
  DropDown1.AddItem("FileModified")
  DropDown1.AddItem("Genre")
  DropDown1.AddItem("Channels")
  DropDown1.AddItem("InvolvedPeople")
  DropDown1.AddItem("ISRC")
  DropDown1.AddItem("LastPlayed")
  DropDown1.AddItem("Lyricist")
  DropDown1.AddItem("Lyrics")
  DropDown1.AddItem("Mood")
  DropDown1.AddItem("MusicComposer")
  DropDown1.AddItem("Occasion")
  DropDown1.AddItem("OriginalArtist")
  DropDown1.AddItem("OriginalLyricist")
  DropDown1.AddItem("OriginalTitle")
  DropDown1.AddItem("OriginalYear")
  DropDown1.AddItem("Path")
  DropDown1.AddItem("PlayCounter")
  DropDown1.AddItem("Publisher")
  DropDown1.AddItem("Quality")
  DropDown1.AddItem("Rating")
  DropDown1.AddItem("RatingString")
  DropDown1.AddItem("SampleRate")
  DropDown1.AddItem("SongLength")
  DropDown1.AddItem("SongLengthString")
  DropDown1.AddItem("Tempo")
  DropDown1.AddItem("TrackOrder")
  DropDown1.AddItem("VBR")
  DropDown1.AddItem("Year")
  DropDown1.ItemIndex = 37
  DropDown1.Style = 2
  DropDown1.UseScript = Script.ScriptPath
  DropDown1.OnSelectFunc = "FillOther"
  DropDown1.Common.SetRect 430,57,120,21

  'show choices
  Dim i : i = 0
  Dim a : a = Split(tmp,",")
  Dim l : Set l = SDB.NewSongList
  For i = 0 To UBound(a)
    Set sit = SDB.Database.QuerySongs(" AND Songs.ID="&a(i))
    If Not sit.EOF Then
    
      Dim Edit1 : Set Edit1 = SDB.UI.NewEdit(Form1)
      Edit1.Common.SetRect 10,(i*25)+85,165,21
      Edit1.Text = sit.Item.Title

      Dim Edit2 : Set Edit2 = SDB.UI.NewEdit(Form1)
      Edit2.Common.SetRect 180,(i*25)+85,120,21
      Edit2.Text = sit.Item.ArtistName

      Dim Edit3 : Set Edit3 = SDB.UI.NewEdit(Form1)
      Edit3.Common.SetRect 305,(i*25)+85,120,21
      Edit3.Text = sit.Item.AlbumName

      Dim Edit4 : Set Edit4 = SDB.UI.NewEdit(Form1)
      Edit4.Common.SetRect 430,(i*25)+85,120,21
      Edit4.Common.ControlName = "Other"&i
      Execute("Edit4.Text = sit.Item."&DropDown1.Text)
  
      Dim RadioButton1 : Set RadioButton1 = SDB.UI.NewRadioButton(Form1)
      RadioButton1.Common.SetRect 555,(i*25)+86,20,20  
      RadioButton1.Common.ControlName = "Radio"&i
      
      Form1.Common.Height = Form1.Common.Height + 25
      Call l.Add(sit.Item)
    End If
  Next
  Set SDB.Objects("RecreateM3USongList") = l

  Dim Button1 : Set Button1 = SDB.UI.NewButton(Form1)
  Button1.Cancel = True
  Button1.Caption = "Cancel"
  Button1.ModalResult = 2
  Button1.Common.SetRect Form1.Common.Width-95,Form1.Common.Height-60,75,25

  Dim Button2 : Set Button2 = SDB.UI.NewButton(Form1)
  Button2.Caption = "Ok"
  Button2.Default = True  
  Button2.ModalResult = 1
  Button2.Common.SetRect Button1.Common.Left-85,Button1.Common.Top,75,25

  '*******************************************************************'
  '* End of form                              Richard Lewis (c) 2007 *'
  '*******************************************************************'
  
  If Form1.ShowModal = 1 Then
    For i = 0 To l.Count-1
      Dim rad : Set rad = Form1.Common.ChildControl("Radio"&i)
      If Not (rad Is Nothing) Then
        If rad.Checked Then
          str = l.Item(i).Path
          Exit Sub
        End If
      End If
    Next
  End If
End Sub

Sub FillOther(Control)
  Dim list : Set list = SDB.Objects("RecreateM3USongList")
  If Not (list Is Nothing) Then
    Dim i : i = 0
    For i = 0 To list.Count-1
      Dim edt : Set edt = Control.Common.TopParent.Common.ChildControl("Other"&i)
      If Not (edt Is Nothing) Then
        Execute("edt.Text = list.Item(i)."&Control.Text)
      End If
    Next
  End If
End Sub

Function NotInArray(s,a)
  NotInArray = False
  Dim i : i = 0
  For i = LBound(a) To UBound(a)    
    If a(i) = s Then
      Exit Function
    End If
  Next
  NotInArray = True
End Function

Function Suitable(s)
  Suitable = False
  If Len(s) = 1 Then
    Exit Function
  End If
  If IsNumeric(s) Then 
    Exit Function
  End if
  Dim a : a = Split(SDB.IniFile.StringValue("Options","IgnoreTHEStrings"),",")
  If Not (NotInArray(s,a)) Then
    Exit Function
  End If
  Suitable = True
End Function

mattisse · Post by **mattisse** » Thu May 24, 2007 3:28 am

Thanks a lot, trixmoto. Great update.

The error messages are gone and the new confirmation screen is a good idea.

I tested the script with a playlist containing 500 songs. For only 4 or 5 tracks that were in my library, it didn't find a match or suggest the proper track. So the algorithm really is doing an awesome job with mactching being way above 90%.

But to prevent that you get bored, I have two issues with the script

- The confirmation screen regularly become too high, so you couldn't click the ok and cancel buttons anymore.
- Tracks that have multiple exact matches still get skipped. It would be nice if the confirmation screen popped up in this case too.

trixmoto · Post by **trixmoto** » Thu May 24, 2007 3:40 am

Ok, I've never had more than 5 results returned so I've not seen that. Not really sure what to do about that but I'll try to come up with something.

Do you like the fact that the confirmation screen comes up for each track, or would you rather one big html confirmation screen at the end for you to select tracks from?

mattisse · Post by **mattisse** » Thu May 24, 2007 5:31 am

Personally I like it the way it is now with the confimation screen coming up after every song that wasn't matched automatically.

It might be a nice bonus feature to have a html screen at the end that shows the final result. But that's not a must.

trixmoto · Post by **trixmoto** » Thu May 24, 2007 7:35 am

Ok, I think I'll add an option in the script to decide whether you want the confirmation screen to appear always/sometimes/never. Default will be the current behaviour (sometimes).