Un Auto Organised 3.0 [MM2+3] - Updated 30/10/2009

Download and get help for different MediaMonkey for Windows 4 Addons.

Moderators: Peke, Gurus

trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Un Auto Organised 3.0 [MM2+3] - Updated 30/10/2009

Post by trixmoto »

This script was based HUGELY on MoDementia's NeedsAutoOrganise script, but now I've written my own parsing algorithm.

The obvious difference is that my version works similar to my other node scripts in the sense that there is a report which runs in the background to populate the list. This is because it works for the whole library and therefore takes more time.

You can download it from my website. As always - feedback is appreciated!

Code: Select all

'
' MediaMonkey Script
'
' NAME: UnAutoOrganised 3.0
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 30/10/2009
'
' NOTE: This script is based on MoDementia's NeedsAutoOrganise script
'
' INSTALL: Copy to Scripts\Auto directory and add the following to Scripts.ini 
'          Don't forget to remove comments (') and set the order appropriately          
'
' [UnAutoOrganised]
' FileName=Auto\UnAutoOrganised.vbs
' ProcName=UnAutoOrganised
' Order=10
' DisplayName=UnAutoOrganised
' Description=Populates UnAutoOrganised node
' Language=VBScript
' ScriptType=1
'
' FIXES: Fixed problems with Folder, Filename and Extension
'        Fixed errors when brackets at beginning of mask
'        Fixed $USE function not accepted as valid
'        Fixed file mappings now includes folder delimiter 
'        Fixed blank track number not behaving correctly
'        Fixed @ wasn't ignoring prefix strings
'

Option Explicit

Dim Debug : Debug = False
Dim IgnoreCase : IgnoreCase = False

Sub onStartUp
  'default settings
  Dim ini : Set ini = SDB.IniFile
  If ini.StringValue("UnAutoOrganised","Debug") = "" Then  
    ini.BoolValue("UnAutoOrganised","Debug") = Debug
  End If
  If ini.StringValue("UnAutoOrganised","ICase") = "" Then  
    ini.BoolValue("UnAutoOrganised","ICase") = IgnoreCase
  End If

  'create node and add to tree
  Dim tree : Set tree = SDB.MainTree
  Dim node : Set node = SDB.Objects("UnAutoOrganisedNode")
  If node Is Nothing Then
    Set node = tree.CreateNode
    node.Caption = "UnAutoOrganised"
    node.IconIndex = 46
    node.UseScript = Script.ScriptPath
    node.OnFillTracksFunct = "ShowUnAutoOrganised"
    node.SortCriteria = 2
    tree.AddNode tree.Node_FilestoEdit,node,3
    Set SDB.Objects("UnAutoOrganisedNode") = node
    
    'add option sheet
    Call SDB.UI.AddOptionSheet("UnAutoOrganised Settings",Script.ScriptPath,"InitSheet","SaveSheet",-3)
  End If
  
  'create exclusion list menu items
  Dim itm1 : Set itm1 = SDB.Objects("UnAutoOrganisedMenu1")
  If itm1 Is Nothing Then
    Set itm1 = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_NP_SendTo,0,0)
    itm1.Caption = "UnAutoOrganised"
    itm1.OnClickFunc = "ItmClick"
    itm1.UseScript = Script.ScriptPath
    itm1.IconIndex = 8   
    Set SDB.Objects("UnAutoOrganisedMenu1") = itm1
    Dim itm2 : Set itm2 = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_TrackList_SendTo,0,0)
    itm2.Caption = "UnAutoOrganised"
    itm2.OnClickFunc = "ItmClick"
    itm2.UseScript = Script.ScriptPath
    itm2.IconIndex = 8 
    Set SDB.Objects("UnAutoOrganisedMenu2") = itm2
  End If
End Sub

Sub ShowUnAutoOrganised(node)
  'check for list
  Dim list : Set list = SDB.Objects("UnAutoOrganisedList")
  If list Is Nothing Then
    'warn node not yet populated
    Call SDB.MessageBox("UnAutoOrganised: You need to select 'File|Create Reports|UnAutoOrganised' from the menu before this node will be populated.",mtInformation,Array(mbOk))
  Else
    'add list to main window
    Dim trax : Set trax = SDB.MainTracksWindow
    Dim i : i = 0
    For i = 0 To list.Count-1
      trax.AddTrack(list.Item(i))
    Next
    'finish off
    trax.FinishAdding
  End If
End Sub

Sub UnAutoOrganised
  'initialise
  Set SDB.Objects("UnAutoOrganisedList") = Nothing
  Dim list : Set list = SDB.NewSongList
  Dim tags : tags = "ABCEFGJKLMOPRSTUVWY"
  Dim tagz : tagz = "ABCDEFGHIJKLMNO"
  Dim alph : alph = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  Dim spec : spec = "@Z"
  Dim ini : Set ini = SDB.IniFile
  Dim mask1 : mask1 = ini.StringValue("RenameMasks","Mask1")
  IgnoreCase = ini.BoolValue("UnAutoOrganised","ICase")
  Debug = ini.BoolValue("UnAutoOrganised","Debug")
  If Debug Then 
    Call clear()
    Call out("mask="&mask1)     
  End If  
  Dim var : Set var = CreateObject("Scripting.Dictionary")
  Set SDB.Objects("UnAutoOrganisedVars") = var
  
  'create progress bar
  Dim prog : Set prog = SDB.Progress
  prog.Value = 0
  Dim iter : Set iter = SDB.Database.OpenSQL("SELECT Count(*) AS SongCount FROM Songs WHERE SongPath NOT LIKE 'http://%'")
  prog.MaxValue = iter.ValueByName("SongCount")
  prog.Text = "UnAutoOrganised: Initialising..."
  
  'get character mappings
  Dim i,j,s,t,u
  Dim map : Set map = CreateObject("Scripting.Dictionary")
  Dim keys : Set keys = ini.Keys("FilenameMappings")
  For i = 0 To keys.Count-1
    s = keys.Item(i)
    j = InStr(s,"=")
    If j > 0 Then
      t = HexToChr(Left(s,j-1))
      If Not (t = "") ANd Not (t = "\") Then
        u = HexToChr(Mid(s,j+1))
        map.Item(t) = u
      End If
    End If
  Next  
  
  'read excluded files
  Dim exc : Set exc = CreateObject("Scripting.Dictionary")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim dat : Set dat = Nothing
  If fso.FileExists(Script.ScriptPath&".dat") Then
    Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",1,False)
    If Not (dat Is Nothing) Then
      While Not (dat.AtEndOfStream)
        exc.Item(dat.ReadLine) = ""
      WEnd
      dat.Close
    End If
  End If
  Dim lst : lst = exc.Keys

  'loop through tracks
  i = 0
  Set iter = SDB.Database.QuerySongs("AND Songs.SongPath NOT LIKE 'http://%'")
  Do While Not iter.EOF
    'update progress bar
    prog.Increase
    prog.Text = "UnAutoOrganised: Checking track "&prog.Value&"/"&prog.MaxValue&" (found: "&i&")..."
    SDB.ProcessMessages  
    
    'calculate path
    Dim song : Set song = iter.Item
    Dim orig : orig = song.Path
    Dim mask : mask = mask1
    Dim perc : perc = False
    Dim asat : asat = False
    Dim text : text = False
    Dim zedd : zedd = False
    Dim path : path = ""
    Dim temp : temp = ""
    Dim atmp : atmp = ""
    Dim char,k,l,m,n

    'logfile
    Dim mess : mess = ""
    If Debug Then mess = vbcrlf&"song="&song.ID&" - "&song.Title&vbcrlf&"mask="&mask&vbcrlf
    
    'process if statements
    While InStr(UCase(mask),"$IF") > 0
      Dim arr : arr = SplitIf(mask)
      If Debug Then mess = mess&mask&"arr(0)="&arr(0)&vbcrlf&"arr(1)="&arr(1)&vbcrlf&"arr(2)="&arr(2)&vbcrlf&"arr(3)="&arr(3)&vbcrlf&"arr(4)="&arr(4)&vbcrlf&"arr(5)="&arr(5)&vbcrlf&"arr(6)="&arr(6)&vbcrlf
      mask = ""
      If Not (arr(0) = "") Then
        temp = arr(0)
        Call SplitTag(temp,arr(0),k)
        Call Translate(song,arr(0),text,k,temp,False)
        If arr(5) = "" Then
          If Debug Then mess = mess&"temp="&temp&vbcrlf
          If temp = "" Then
            mask = arr(2) 
          Else
            If (temp = Zeros(k)) And (arr(0) = "%T" Or arr(0) = "%Y") Then
              mask = arr(2)                  
            Else
              mask = arr(1)
            End If
          End If            
        Else
          atmp = arr(5)
          Call SplitTag(atmp,arr(5),k)
          Call Translate(song,arr(5),text,k,atmp,False)
          If Debug Then mess = mess&temp&"="&atmp&vbcrlf
          If Condition(temp,arr(6),atmp) Then
            mask = arr(1) 
          Else
            mask = arr(2)
          End If            
        End If
      End If
      mask = arr(3)&mask&arr(4)
      If Debug Then mess = mess&"mask="&mask&vbcrlf
    WEnd       

    'translate tags
    temp = ""
    text = False
    For j = 1 To Len(mask)
      char = Mid(mask,j,1)
      If perc Then
        If InStr(spec,char) > 0 Then
          Select Case char
            Case "Z"
              zedd = True
            Case "@"
              asat = True
          End Select
        Else
          If zedd Then
            atmp = tagz
          Else
            atmp = tags
          End If
          If InStr(atmp,char) > 0 Then
            If IsNumeric(temp) Then
              k = CInt(temp)
            Else
              k = 0
            End If
            If zedd Then
              atmp = "%Z"&char
            Else
              atmp = "%"&char
            End If
            Call Translate(song,atmp,text,k,temp,asat)
            If (temp = "") And Not (atmp = "%ZM") Then
              temp = SDB.Localize("Unknown")
            End If
            path = path&temp
            temp = ""
            perc = False
            asat = False
            text = False
            zedd = False
          Else
            If (zedd = False) And ((char = "N") Or (char = "D")) Then
              If IsNumeric(temp) Then
                k = CInt(temp)
              Else
                If char = "N" Then
                  k = 4
                End If
                If char = "D" Then
                  k = 3
                End If
              End If
              path = path&Skip(k)
              temp = ""
              perc = False
              asat = False
              text = False
              zedd = False
            Else
              temp = temp&char              
            End If
          End If
        End If
      Else
        If char = "%" Then
          perc = True
        Else
          path = path&char
        End If
      End If
    Next
    
    'correct filename
    While (InStr(path,".\") > 0)
      path = Replace(path,".\","\")
    WEnd    
    If Left(path,2) = "\\" Then
      s = "\"
    Else
      s = ""
    End If
    While (InStr(path,"\\") > 0)
      path = Replace(path,"\\","\")
    WEnd    
    path = Replace(Replace(s&path,"$)",")"),"$,",",")
    If Mid(path,2,1) = ":" Then
      path = Left(path,2)&CorrectPath(map,Mid(path,3))
    Else
      path = CorrectPath(map,path)
    End If
    
    'process functions
    Dim goes : goes = 0
    Dim dpos : dpos = 1
    Dim back : back = path
    While (InStr(dpos,path,"$") > 0 And goes < 100)
      Call Func(path,dpos)
      goes = goes+1
    WEnd
    If goes = 100 Then
      If Debug Then 
        Call out("[Error processing functions]")
      End If
      path = back
    End If    
    
    'check path against mask
    If Left(mask,2) = ".\" Then
      orig = Mid(orig,InStrRev(orig,"\"))
    End If        
    path = path&Mid(orig,InStrRev(orig,"."))
    If IgnoreCase Then
      orig = UCase(orig)
      path = UCase(path)
    End If
    If Not(orig = path) And (Len(orig) = Len(path)) And (InStr(path,Chr(0)) > 0) Then
      Dim b : b = True
      For n = 1 To Len(orig)
        char = Mid(path,n,1)
        If Not (char = Chr(0)) And Not(char = Mid(orig,n,1)) Then
          b = False
          Exit For
        End If
      Next
      If b Then
        path = orig
      End If
    End If
    If Not (orig = path) Then
      If NotInList(song.Path,lst) Then
        list.Add(song)
        i = i + 1
        If Debug Then 
          Call out(mess&"orig="&orig&vbcrlf&"path="&path)     
        End If
      End If
    End If
    
    'check next track
    If prog.Terminate Then 
      Exit Do
    Else
      iter.Next
    End If
  Loop
  
  'finish off
  Set prog = Nothing
  Set SDB.Objects("UnAutoOrganisedList") = list
  Set SDB.Objects("UnAutoOrganisedVars") = Nothing
  j = SDB.MessageBox("UnAutoOrganised: Do you want to see the "&i&" results now?",mtConfirmation,Array(mbYes,mbNo))
  If j = mrYes Then
    'show node
    Dim node : Set node = SDB.Objects("UnAutoOrganisedNode")
    If Not (node Is Nothing) Then
      Dim tree : Set tree = SDB.MainTree
      tree.CurrentNode = tree.Node_Library
      tree.Node_Library.Expanded = True
      tree.CurrentNode = tree.Node_FilestoEdit
      tree.Node_FilestoEdit.Expanded = True
      tree.CurrentNode = node
    End If
  End If
End Sub

Function Zeros(i)
  Zeros = ""
  While (i > 0)
    Zeros = Zeros&"0"
    i = i-1
  WEnd
End Function

Function Condition(a,op,b)
  Condition = False
  On Error Resume Next
  Execute("If a "&op&" b Then Condition = True")
  If Err.Number <> 0 Then
    Call out("cond="&a&" "&op&" "&b&" ["&Err.Number&"]")
    Err.Clear
  End If
  On Error Goto 0
End Function    

Sub Func(path,dpos)
  Dim pos : pos = InStr(dpos,path,"$")
  Dim str1 : str1 = Left(path,pos-1)
  Dim temp : temp = Mid(path,pos+1)
  dpos = pos+1
  pos = InStr(temp,"(")
  If pos = 0 Then
    Exit Sub
  End If
  
  'check mode
  Dim mode : mode = UCase(Left(temp,pos-1))
  Select Case mode
    Case "LEFT"
    Case "RIGHT"
    Case "MID"
    Case "TRIM"
    Case "UPPER"
    Case "LOWER"
    Case "FIRST"
    Case "REMOVEPREFIX"
    Case "MOVEPREFIX"
    Case "GROUP"
    Case "REPLACE"
    Case "ASSIGN"
    Case "USE"    
    Case "LEN"
    Case Else
      Exit Sub
  End Select
  
  'find closing bracket
  temp = Mid(temp,pos+1)
  If InStr(temp,")") = 1 Then
    path = str1&Mid(temp,2)
    Exit Sub
  End If
  pos = 1
  Dim opn : opn = 1
  While (InStr(pos,temp,"(") > 0)
    opn = opn+1
    pos = InStr(pos,temp,"(")+1
  WEnd
  While ((opn > 0) And (pos > 1))
    opn = opn-1
    pos = InStr(pos,temp,")")+1
  WEnd
  If pos = 1 Then
    pos = InStr(temp,")")+1
  End If
  
  'perform function
  Dim str2 : str2 = Mid(temp,pos)
  temp = Left(temp,pos-2)
  Select Case mode
    Case "LEFT"
      temp = FuncLeft(temp)
    Case "RIGHT"
      temp = FuncRight(temp)
    Case "MID"
      temp = FuncMid(temp)
    Case "TRIM"
      temp = Trim(temp)
    Case "UPPER"
      temp = UCase(temp)
    Case "LOWER"
      temp = LCase(temp)
    Case "FIRST"
      temp = FuncFirst(temp)
    Case "REMOVEPREFIX"
      temp = FuncRemovePrefix(temp)
    Case "MOVEPREFIX"
      temp = FuncMovePrefix(temp)
    Case "GROUP"
      temp = FuncGroup(temp)
    Case "REPLACE"
      temp = FuncReplace(temp)
    Case "ASSIGN"
      temp = FuncAssign(temp)
    Case "USE"
      temp = FuncUse(temp)
    Case "LEN"      
      temp = Length(temp)
  End Select
  path = str1&temp&str2
End Sub

Function FuncLeft(temp)
  FuncLeft = temp
  Dim p : p = InStrRev(temp,",")
  If p > 0 Then
    Dim n : n = Mid(temp,p+1)
    If IsNumeric(n) Then
      Dim s : s = Left(temp,p-1)
      FuncLeft = Left(s,n)
    End If
  End If
End Function

Function FuncRight(temp)
  FuncRight = temp
  Dim p : p = InStrRev(temp,",")
  If p > 0 Then
    Dim n : n = Mid(temp,p+1)
    If IsNumeric(n) Then
      Dim s : s = Left(temp,p-1)
      FuncRight = Right(s,n)
    End If
  End If
End Function

Function FuncMid(temp)
  FuncMid = temp
  Dim p : p = InStrRev(temp,",")
  If p > 0 Then
    Dim i : i = Mid(temp,p+1)
    If IsNumeric(i) Then
      Dim s : s = Left(temp,p-1)
      p = InStrRev(s,",")
      If p > 0 Then
        Dim n : n = Mid(s,p+1)
        If IsNumeric(n) Then
          s = Left(s,p-1)
          FuncMid = Mid(s,i,n)
        Else
          FuncMid = Mid(s,i)
        End If
      Else
        FuncMid = Mid(s,i)
      End If
    End If
  End If
End Function

Function FuncFirst(temp)
  FuncFirst = temp
  Dim p : p = InStrRev(temp,",")
  If p > 0 Then
    Dim m : m = "0"
    Dim n : n = Mid(temp,p+1)
    If IsNumeric(n) Then
      Dim s : s = Left(temp,p-1)
      p = InStrRev(s,",")
      If p > 0 Then
        m = Mid(s,p+1)
        If IsNumeric(m) Then 
          s = Left(s,p-1)
        Else
          m = "0"
        End If
      End If
      Dim a : a = Split(s,";")
      If Int(n) >= (UBound(a)+1) Then
        FuncFirst = s
      Else
        FuncFirst = Trim(a(Int(m)))
        For p = 1 To n-1
          FuncFirst = FuncFirst&"; "&Trim(a(Int(m)+p))
        Next
      End If
    End If
  End If
End Function

Function FuncRemovePrefix(temp)
  FuncRemovePrefix = temp
  If Not (SDB.IniFile.BoolValue("Options", "IgnoreTHEs")) Then
    Exit Function
  End If
  Dim i : i = 0
  Dim str : str = SDB.IniFile.StringValue("Options", "IgnoreTHEStrings")
  Dim arr : arr = Split(str,",")
  For i = 0 To UBound(arr)
    str = UCase(Trim(arr(i)))&" "
    If Left(temp,Len(str)) = str Then
      FuncRemovePrefix = Mid(temp,Len(str)+1)
      Exit For
    End If
  Next  
End Function

Function FuncMovePrefix(temp)
  FuncMovePrefix = SDB.Tools.StringForSorting(temp)
End Function

Function FuncGroup(temp)
  FuncGroup = temp
  Dim p : p = InStrRev(temp,",")
  If p > 0 Then
    Dim n : n = Mid(temp,p+1)
    If IsNumeric(n) Then
      Dim a : a = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      Dim c : c = Left(temp,1)
      Dim k : k = 1
      FuncGroup = "0-9"
      temp = Mid(a,k,n)
      While Not (temp = "")
        If InStr(temp,c) > 0 Then 
          FuncGroup = temp
          temp = ""
        Else
          k = k + l
          temp = Mid(a,k,n)
        End If
      WEnd
    End If
  End If
End Function

Function FuncReplace(temp)
  FuncReplace = temp
  Dim p : p = InStrRev(temp,",")
  If p > 0 Then
    Dim s : s = Left(temp,p-1)  
    Dim t : t = Mid(temp,p+1)
    p = InStrRev(s,",")
    If p > 0 Then
      Dim u : u = Mid(s,p+1)
      s = Left(s,p-1)
      FuncReplace = Mid(s,t,u)
    End If
  End If
End Function

Function FuncAssign(temp)
  FuncAssign = ""
  Dim var : Set var = SDB.Objects("UnAutoOrganisedVars")
  If var Is Nothing Then
    Set var = CreateObject("Scripting.Dictionary")
  End If
  Dim p : p = InStr(temp,",")
  If p > 0 Then
    Dim s : s = Left(temp,p-1)
    Dim t : t = Mid(temp,p+1)
    var.Item(s) = t
  End If
  Set SDB.Objects("UnAutoOrganisedVars") = var
End Function

Function FuncUse(temp)
  FuncUse = ""
  Dim var : Set var = SDB.Objects("UnAutoOrganisedVars")
  If Not (var Is Nothing) Then
    FuncUse = var.Item(temp)
  End If
End Function

Function Skip(k)
  Skip = ""
  Dim i : i = 0
  For i = 1 To k
    Skip = Skip&Chr(0)
  Next
End Function

Function SplitIf(str)  
  'pre
  Dim mess : mess = ""
  Dim i : i = 0
  Dim j : j = 0  
  Dim ope : ope = Array("<=",">=","<>","=","<",">")
  Dim arr : arr = Array("","","","","","","")
  Dim pos : pos = InStr(UCase(str),"$IF")
  If pos > 2 Then
    arr(3) = Left(str,pos-1)
  End If
  str = Mid(str,pos+4)
  
  'post  
  pos = 0
  If InStr(str,")") > 1 Then
    While (pos = 0 And i<Len(str))
      i = i + 1
      Select Case Mid(str,i,1)
        Case "(" 
          Call CheckFunctions(i,j,str)
        Case ")"
          If Not (Mid(str,i-1,1) = "$") Then
            If j = 0 Then
              pos = i
            Else
              j = j - 1
            End If
          End If          
      End Select
    WEnd
    If pos > 1 Then
      If pos < Len(str) Then
        arr(4) = Mid(str,pos+1)
      End If
      str = Left(str,pos-1)
    Else
      str = ""
    End If
  Else
    str = ""
  End If  
  
  'if
  pos = InStr(str,",")
  If pos > 1 Then
    arr(0) = Left(str,pos-1)
    str = Mid(str,pos+1)
    For i = 0 To UBound(ope)
      pos = InStr(arr(0),ope(i))
      If pos > 0 Then
        Dim tstr : tstr = arr(0)
        If pos > 1 Then
          arr(0) = Left(tstr,pos-1)
          If pos < Len(tstr) Then
            arr(5) = Mid(tstr,pos+1)
          End If
        Else
          arr(0) = ""
        End If
        arr(6) = ope(i)
        Exit For
      End If  
    Next
  Else
    str = ""
  End If
  
  'then
  pos = 0
  If InStr(str,",") > 0 Then
    i = 0
    j = 0
    While (pos = 0 And i<Len(str))
      i = i + 1
      Select Case Mid(str,i,1)
        Case "(" 
          Call CheckFunctions(i,j,str)
        Case ")"
          If Not (Mid(str,i-1,1) = "$") Then
            j = j - 1
          End If
        Case ","
          If j = 0 Then
            If i = 1 Then
              pos = 1
            Else
              If Not (Mid(str,i-1,1) = "$") Then
                pos = i
              End If
            End If
          End If
      End Select
    WEnd
    If pos > 0 Then
      If pos > 1 Then
        arr(1) = Left(str,pos-1)
      End If
      arr(2) = Mid(str,pos+1)
    Else
      arr(0) = ""
    End If
  Else
    arr(0) = ""
  End If

  str = mess
  SplitIf = arr
End Function

Sub CheckFunctions(i,j,str)
  Dim s : s = UCase(str)
  If i < 4 Then
    Exit Sub
  End If
  Select Case Mid(s,i-3,3)
    Case "$IF"
      j = j + 1
    Case "EFT"
      If i > 5 Then
        If Mid(s,i-5,5) = "$LEFT" Then
          j = j + 1
        End If
      End If
    Case "GHT"
      If i > 6 Then
        If Mid(s,i-6,6) = "$RIGHT" Then
          j = j + 1
        End If
      End If
    Case "MID"
      If i > 4 Then
        If Mid(s,i-4,4) = "$MID" Then
          j = j + 1
        End If
      End If      
    Case "RIM"
      If i > 5 Then
        If Mid(s,i-5,5) = "$TRIM" Then
          j = j + 1
        End If
      End If      
    Case "PER"
      If i > 6 Then
        If Mid(s,i-6,6) = "$UPPER" Then
          j = j + 1
        End If
      End If            
    Case "WER"
      If i > 6 Then
        If Mid(s,i-6,6) = "$LOWER" Then
          j = j + 1
        End If
      End If            
    Case "RST"
      If i > 6 Then
        If Mid(s,i-6,6) = "$FIRST" Then
          j = j + 1
        End If
      End If      
    Case "FIX"
      If i > 11 Then
        If Mid(s,i-11,11) = "$MOVEPREFIX" Then
          j = j + 1
        Else
          If i > 13 Then
            If Mid(s,i-13,13) = "$REMOVEPREFIX" Then
              j = j + 1
            End If
          End If
        End If                  
      End If      
    Case "OUP"
      If i > 6 Then
        If Mid(s,i-6,6) = "$GROUP" Then
          j = j + 1
        End If
      End If            
    Case "RST"
      If i > 8 Then
        If Mid(s,i-8,8) = "$REPLACE" Then
          j = j + 1
        End If
      End If        
    Case "IGN"
      If i > 7 Then
        If Mid(s,i-7,7) = "$ASSIGN" Then
          j = j + 1
        End If
      End If            
    Case "LEN"
      If i > 4 Then
        If Mid(s,i-4,4) = "$LEN" Then
          j = j + 1
        End If
      End If            
  End Select
End Sub

Sub SplitTag(str,tag,num)
  tag = str
  num = 0
  If Left(str,1) = "%" Then
    Dim i : i = 0
    Dim t : t = "0"
    Dim v : v = "0123456789"
    For i = 2 To Len(str)
      Dim c : c = Mid(str,i,1)
      If InStr(v,c) = 0 Then
        Exit For
      Else
        t = t&c
      End If
    Next
    tag = "%"&Mid(str,i)
    num = Int(t)
  End If
End Sub

Sub Translate(itm,tag,text,k,tout,asat)
  tout = tag
  text = False
  Dim i : i = 0
  
  Select Case tag
    Case "%A"
      tout = itm.ArtistName
      text = True
    Case "%B"
      tout = itm.Bitrate      
      If k = 0 Then k = 3
    Case "%C"
      tout = itm.Author
      text = True
    'D = <Auto Number>
    Case "%E"
      tout = GetPart(3,itm.Path)
      text = True
    Case "%F"
      tout = GetPart(2,itm.Path)
      text = True
    Case "%G"
      tout = itm.Genre    
      text = True     
    'H = <Track Length>
    'I = <Playback Time>
    Case "%J"
      tout = itm.Custom4
      text = True
    Case "%K"
      tout = itm.Custom5    
      text = True
    Case "%L"
      tout = itm.AlbumName
      text = True
    Case "%M"
      If itm.BPM > 0 Then
        tout = itm.BPM
      Else
        tout = "0"
      End If    
      If k = 0 Then k = 3
    'N = <Random>
    Case "%O"
      tout = itm.Path    
      text = True
    Case "%P"
      tout = GetPart(1,itm.Path)
      text = True
    'Q = <Playlist>
    Case "%R"
      tout = itm.AlbumArtistName    
      text = True
    Case "%S"
      tout = itm.Title
      text = True
    Case "%T"
      If itm.TrackOrderStr = "" Then
        tout = 0
      Else
        tout = itm.TrackOrderStr
        If Not (IsNumeric(tout)) Then
          text = True
        End If        
      End If
    Case "%U"
      tout = itm.Custom1
      text = True
    Case "%V"
      tout = itm.Custom2
      text = True
    Case "%W"
      tout = itm.Custom3
      text = True     
    'X = <Skip>
    Case "%Y"
      tout = itm.Year
      If k = 0 Then k = 4
    Case "%ZA"
      tout = itm.Mood
      text = True
    Case "%ZB"
      tout = itm.Occasion
      text = True
    Case "%ZC"
      tout = itm.Tempo
      text = True
    Case "%ZD"
      tout = itm.Comment
      text = True
    Case "%ZE"
      tout = itm.Encoder
      text = True
    Case "%ZF"
      tout = itm.ISRC
      text = True
    Case "%ZG"
      tout = itm.Lyricist
      text = True
    Case "%ZH"
      tout = itm.OriginalArtist
      text = True
    Case "%ZI"
      tout = itm.OriginalLyricist
      text = True
    Case "%ZJ"
      tout = itm.OriginalTitle
      text = True
    Case "%ZK"
      tout = itm.Publisher
      text = True
    Case "%ZL"
      tout = itm.Quality
      text = True
    Case "%ZM"
      If itm.DiscNumberStr = "" Then
        tout = ""
        text = True
      Else
        tout = itm.DiscNumberStr
        If Not (IsNumeric(tout)) Then
          text = True
        End If        
      End If
    Case "%ZN"
      tout = itm.MusicComposer
      text = True
    Case "%ZO"
      tout = itm.Grouping
      text = True
  End Select 
  
  If Not (tout = "") Then
    Dim l : l = Abs(k)
    If asat Then
      If l = 0 Then 
        l = 3
      End If
      Dim alph : alph = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      tout = FuncRemovePrefix(tout)
      Dim c : c = Left(tout,1)
      tout = "0-9"
      k = 1
      tag = Mid(alph,k,l)
      While Not (tag = "")
        If InStr(tag,c) > 0 Then 
          tout = tag
          tag = ""
        Else
          k = k + l
          tag = Mid(alph,k,l)
        End If
      WEnd
    Else
      If l > 0 Then
        If l < Len(tout) Then
          If text Or tag = "%B" Then
            tout = Left(tout,l)
          End If
        Else
          If text Then
            If Len(tout) < l Then
              If k < 0 Then
                While Len(tout) < l
                  tout = tout&" "
                WEnd
              Else
                While Len(tout) < l
                  tout = " "&tout
                WEnd
              End If
            Else
              tout = Left(tout,l)
            End If
          Else
            While Len(tout) < l
              tout = "0"&tout
            WEnd
          End If
        End If
      End If
    End If    
  End If  
End Sub

Function GetPart(mode,path)
  GetPart = ""
  Dim p2 : p2 = InStrRev(path,"\")
  If p2 = 0 Then
    Exit Function
  End If
  If mode = 1 Then 'Folder
    Dim p1 : p1 = InStr(path,"\")
    If p1 < p2 Then
      GetPart = Mid(path,p1+1,p2-p1-1)
    End If
    Exit Function
  End If   
  Dim p3 : p3 = InStrRev(path,".")
  If mode = 2 Then 'Filename
    If p3 > p2 Then
      GetPart = Mid(path,p2+1,p3-p2-1)
    End If
    Exit Function
  End If
  If mode = 3 Then 'Extension
    If p3 > p2 Then
      GetPart = Mid(path,p3+1)
    End If
    Exit Function
  End If
End Function

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

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

Function NotInList(key,lst)
  NotInList = False
  Dim h : h = 0
  For h = 0 To UBound(lst)
    If Right(lst(h),1) = "\" Then
      If InStr(key,lst(h)) = 1 Then
        Exit Function
      End If
    Else
      If key = lst(h) Then 
        Exit Function
      End If
    End If
  Next
  NotInList = True
End Function

Sub ItmClick(itm)
  Dim list : Set list = SDB.SelectedSongList
  If list.Count = 0 Then
    Exit Sub
  End If

  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim dat : Set dat = Nothing
  Dim i : i = 0
  Dim str : str = Left(list.Item(0).Path,InStrRev(list.Item(0).Path,"\"))
  Dim dir : dir = False
  If list.Count > 1 Then
    dir = True
    For i = 1 To list.Count-1
      If Not (Left(list.Item(i).Path,InStrRev(list.Item(i).Path,"\")) = str) Then
        dir = False
        Exit For
      End If
    Next
  End If
  If dir Then
    i = SDB.MessageBox("UnAutoOrganised: Do you want to exclude the folder '"&str&"'? (Click 'No' to exclude each file individually)",mtConfirmation,Array(mbYes,mbNo,mbCancel))
    Select Case i
      Case mrYes
        Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",8,True)  
        dat.WriteLine(str)
      Case mrNo
        dir = False
    End Select
  End If
  If Not (dir) Then
    If (dat Is Nothing) And (list.Count > 1) Then
      Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",8,True)  
    End If
    For i = 0 To list.Count-1
      dat.WriteLine(list.Item(i).Path)
    Next
  End If
  If Not (dat Is Nothing) Then
    dat.Close
  End If
End Sub

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("UnAutoOrganised","Filename") = "Auto\UnAutoOrganised.vbs"
    inif.StringValue("UnAutoOrganised","Procname") = "UnAutoOrganised"
    inif.StringValue("UnAutoOrganised","Order") = "10"
    inif.StringValue("UnAutoOrganised","DisplayName") = "UnAutoOrganised"
    inif.StringValue("UnAutoOrganised","Description") = "Populates UnAutoOrganised node"
    inif.StringValue("UnAutoOrganised","Language") = "VBScript"
    inif.StringValue("UnAutoOrganised","ScriptType") = "1"
    SDB.RefreshScriptItems
  End If
  Call onStartUp()
End Sub

Sub InitSheet(Sheet)
  Dim ini : Set ini = SDB.IniFile  
  Dim ui : Set ui = SDB.UI
  Dim wsh : Set wsh = CreateObject("WScript.Shell")
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\UnAutoOrganised.log"  
  Dim exc : Set exc = CreateObject("Scripting.Dictionary")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim dat : Set dat = Nothing
  If fso.FileExists(Script.ScriptPath&".dat") Then
    Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",1,False)
    If Not (dat Is Nothing) Then
      While Not (dat.AtEndOfStream)
        exc.Item(dat.ReadLine) = ""
      WEnd
      dat.Close
    End If
  End If
  Dim lst : lst = exc.Keys  
  
  Dim edt : Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 5, 10, 400, 20
  edt.Common.ControlName = "UAODebug"
  edt.Caption = "Create logfile '"&loc&"'?"
  edt.Checked = ini.BoolValue("UnAutoOrganised","Debug")
  
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 5, 35, 400, 20
  edt.Common.ControlName = "UAOICase"
  edt.Caption = "Ignore case (non-case sensitive)?"
  edt.Checked = ini.BoolValue("UnAutoOrganised","ICase")

  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 60, 400, 20
  edt.Caption = "EXCLUDE FILES AND FOLDERS..."
  edt.Autosize = False
  
  Dim h,i,j
  If exc.Count = 0 Then
    j = 0
  Else
    j = UBound(lst)
  End If
  For i = 0 To j
    h = 85+(22*i)
    Set edt = ui.NewEdit(Sheet)
    edt.Common.SetRect 5, h, 400, 21
    edt.Common.ControlName = "UAOEdit"&i
    If exc.Count > 0 Then  
      edt.Text = lst(i)
    End If
    Set edt = ui.NewButton(Sheet)
    edt.Common.SetRect 407, h, 21, 21
    edt.Common.ControlName = "UAOBut1"&i
    edt.Common.Hint = "Select a file"
    edt.Caption = ".."
    edt.UseScript = Script.ScriptPath
    edt.OnClickFunc = "Button1Click"
    Set edt = ui.NewButton(Sheet)
    edt.Common.SetRect 430, h, 21, 21
    edt.Common.ControlName = "UAOBut2"&i
    edt.Common.Hint = "Select a folder"
    edt.Caption = ".\"
    edt.UseScript = Script.ScriptPath
    edt.OnClickFunc = "Button2Click"
    Set edt = ui.NewButton(Sheet)
    edt.Common.SetRect 453, h, 21, 21
    edt.Common.ControlName = "UAOBut3"&i
    edt.Common.Hint = "Add a row"
    edt.Caption = "+"
    edt.UseScript = Script.ScriptPath
    edt.OnClickFunc = "Button3Click"    
  Next
End Sub

Sub Button1Click(but)
  Dim s : s = Mid(but.Common.ControlName,8)
  If IsNumeric(s) Then  
    Dim edt : Set edt = but.Common.TopParent.Common.ChildControl("UAOEdit"&s)
    If Not (edt Is Nothing) Then
      Dim d : Set d = SDB.CommonDialog
      d.Filter = "Any music file |*.*"
      d.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly + cdlOFNNoChangeDir
      d.InitDir = edt.Text
      d.ShowOpen
      If d.Ok Then
        edt.Text = d.FileName
      End If 
    End If
  End If
End Sub

Sub Button2Click(but)
  Dim s : s = Mid(but.Common.ControlName,8)
  If IsNumeric(s) Then  
    Dim edt : Set edt = but.Common.TopParent.Common.ChildControl("UAOEdit"&s)
    If Not (edt Is Nothing) Then
      s = SDB.SelectFolder(edt.Text,"Select a folder:")
      If Not (s = "") Then
        If Right(s,1) = "\" Then
          edt.Text = s
        Else
          edt.Text = s&"\"
        End If
      End If
    End If
  End If
End Sub

Sub Button3Click(but)
  Dim s : s = Mid(but.Common.ControlName,8)
  If IsNumeric(s) Then  
    Dim i : i = Int(s)+1
    Dim h : h = 85+(22*i)
    Dim ui : Set ui = SDB.UI
    Dim Sheet : Set Sheet = but.Common.TopParent
    Dim edt : Set edt = ui.NewEdit(Sheet)
    edt.Common.SetRect 5, h, 400, 21
    edt.Common.ControlName = "UAOEdit"&i
    Set edt = ui.NewButton(Sheet)
    edt.Common.SetRect 407, h, 21, 21
    edt.Common.ControlName = "UAOBut1"&i
    edt.Common.Hint = "Select a file"
    edt.Caption = ".."
    edt.UseScript = Script.ScriptPath
    edt.OnClickFunc = "Button1Click"
    Set edt = ui.NewButton(Sheet)
    edt.Common.SetRect 430, h, 21, 21
    edt.Common.ControlName = "UAOBut2"&i
    edt.Common.Hint = "Select a folder"
    edt.Caption = ".\"
    edt.UseScript = Script.ScriptPath
    edt.OnClickFunc = "Button2Click"
    Set edt = ui.NewButton(Sheet)
    edt.Common.SetRect 453, h, 21, 21
    edt.Common.ControlName = "UAOBut3"&i
    edt.Common.Hint = "Add a row"
    edt.Caption = "+"
    edt.UseScript = Script.ScriptPath
    edt.OnClickFunc = "Button3Click"    
  End If
End Sub

Sub SaveSheet(Sheet)
  Dim ini : Set ini = SDB.IniFile
  ini.BoolValue("UnAutoOrganised","Debug") = Sheet.Common.ChildControl("UAODebug").Checked
  ini.BoolValue("UnAutoOrganised","ICase") = Sheet.Common.ChildControl("UAOICase").Checked
  
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim dat : Set dat = fso.OpenTextFile(Script.ScriptPath&".dat",2,True)
  Dim i : i = 0
  Dim j : j = 0
  Dim edt : Set edt = Sheet.Common.ChildControl("UAOEdit"&i)
  While Not (edt Is Nothing)
    If Not (edt.Text = "") Then
      dat.WriteLine(edt.Text)
      j = j+1
    End If
    i = i+1
    Set edt = Sheet.Common.ChildControl("UAOEdit"&i)
  WEnd
  dat.Close
  If j = 0 Then
    Call fso.DeleteFile(Script.ScriptPath&".dat")
  End If
End Sub

Function CorrectPath(map,path)
  CorrectPath = path
  Dim i : i = 0
  Dim a : a = map.Keys
  For i = 0 To UBound(a)
    CorrectPath = Replace(CorrectPath,a(i),map.Item(a(i)))
  Next
End Function

Function HexToChr(h)
  HexToChr = ""
  If h = "" Then
    Exit Function
  End If
  Dim c : c = 0
  Dim i : i = 0
  For i = Len(h) To 1 Step -1
    Dim d : d = Mid(h,i,1)
    d = Instr("0123456789ABCDEF",UCase(d))-1
    If d >= 0 Then
      c = c+(d*(16^(Len(h)-i)))
    Else
      c = 0
      Exit For
    End If
  Next
  If c < 256 Then
    HexToChr = Chr(c)
  End If
End Function
Last edited by trixmoto on Sun Jun 15, 2008 10:31 am, edited 16 times in total.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

Could you possibly elaborate a tad more one what exactly this does, or how? I know... I'm a pain :P
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

When you run the report, it uses the last mask you used to Auto-Organise your tracks, and compares each tracks location against this mask. Any that do not match the mask are added to a list. Then when this is complete, clicking on the node in Files To Edit will show you the list. Selecting all of these tracks and clickingAuto-Organise should give you a confirmation window where every single track is highlighted! :)

N.B. MS Office should not be necessary for this version!
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
durden999uk
Posts: 91
Joined: Sun Apr 23, 2006 6:18 pm
Location: England

Post by durden999uk »

Hi Trixmoto,

I have tried out the script - I love the idea (credit to yourself, and, of course, MoDementia), but when I run it, all my tracks appear in the node, and very few/none actually need organising. Any suggestions?

Ben
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

What mask are you using?
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
durden999uk
Posts: 91
Joined: Sun Apr 23, 2006 6:18 pm
Location: England

Post by durden999uk »

C:\Documents and Settings\Ben\My Documents\Music\<Artist>\<Album>\<Track#> - <Title>

Exactly as it appears in MM.
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

Much like durden, I seem to have the same issue. The last Mask I used was:
C:\Documents and Settings\winxp\My Documents\My Music\Temp Music Folder\<Album Artist>\<Year> - <Album>\<Track#> - <Title>
And when running the report, it put 4274 of 4274 in the Node :\
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

I think I'll need to create a debug version so that I can see what's going on.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

If you are having problems, please install this debug version and run it once. Then could you please email me the resulting logfile: "MediaMonkey\Scripts\Auto\UnAutoOrganised.vbs.log"

[Link removed]
Last edited by trixmoto on Tue Sep 19, 2006 6:17 am, edited 1 time in total.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
durden999uk
Posts: 91
Joined: Sun Apr 23, 2006 6:18 pm
Location: England

Post by durden999uk »

Hi Trixmoto,

I've e-mailed a debug logfile to you, hope it helps.

Ben
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

I have also E-Mail you a log... actually, two. Don't ask. :oops:
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

New version (1.1) is now available from my website. It will now compare the full file path. This should fix your problems, as the problems were with removing the filepath.

A debug log is still created, but only if there are mismatching files - please email to me if you have any problems.

Also, I've fixed a small bug (with MM really) where MM translates <Track#> as <Track#:2> (01, 02, 03...) instead of 1, 2, 3... as it should.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
durden999uk
Posts: 91
Joined: Sun Apr 23, 2006 6:18 pm
Location: England

Post by durden999uk »

Fantastic work, Trixmoto - it works perfectly now. And well done on what must be the fastest response time ever. I posted the logfile this morning around 9am, and by lunchtime I've got an updated, fully functioning version of the script. Well done, Sir!

Ben
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

Well I'm glad this now works for you. Thanks for your kind words! :D
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

Working great for me now too :D

Only beef I got with your script now is that it doesn't appear to work with the $if() statements. :cry:
Post Reply