Genre Sorting

serendip1959 · Post by **serendip1959** » Fri Aug 22, 2014 8:48 am

I have written an add on for Media Monkey 4 or greater that sorts and de-duplicates the genre field/tag. It puts multiple genres into alphabetical order and removes duplicates.

It can be downloaded from here http://cranachan.co.uk/media-monkey-genre-sorting/

Feedback and suggestions for improvement welcome.

Darryl_Gittins · Post by **Darryl_Gittins** » Thu Jun 18, 2020 1:27 pm

I'd love to try this but the link is dead. Is it available still?

Erwin Hanzl · Post by **Erwin Hanzl** » Thu Jun 18, 2020 4:13 pm

CustomFieldsTagger http://www.happymonkeying.com/plugin.php?q=300108

Close MM after installation.
Windows Explorer: Enter in the address bar "%appdata%
Folder: MediaMonkey
Folder: Scripts
Folder: Auto
Open file CusomFieldsTagger with NotePad and add "FieldList" and "FieldListDB" with the entry "Genre":

Code: Select all

Sub OnStartup
....
    
    FieldList = Array("Genre","Custom1", "Custom2", "Custom3", "Custom4", "Custom5", "Mood", "Occasion", "Quality", "Tempo", "Comment",  "Grouping")
    FieldListDB = Array("Genre", "Custom1", "Custom2", "Custom3", "Custom4", "Custom5", "Mood", "Occasion", "Quality", "Tempo", "Comment", "GroupDesc")

Save file
Close NotePad

OPEN MM
Tools> Options> Library .. Custom Fields Tagger - aktivate "Genre"

Access without exception via the context menu of selected files.
(right mousekey)

Darryl_Gittins · Post by **Darryl_Gittins** » Thu Jun 18, 2020 5:41 pm

Thanks!

I think I did it right but "Genre" does not appear in the addon's page with the checkboxes. I open Tools> Options> Library .. Custom Fields Tagger - there is no "Genre" listed.

Here's what I have in the vbs:

...

Sub OnStartup

' Initialize global variables
Set UI = SDB.UI
Set INI = SDB.IniFile

Set MIs = CreateObject("Scripting.Dictionary")
MIs.CompareMode = 1

FieldList = Array("Custom1", "Custom2", "Custom3", "Custom4", "Genre", "Mood", "Occasion", "Quality", "Tempo", "Comment", "Grouping")
FieldListDB = Array("Custom1", "Custom2", "Custom3", "Custom4", "Genre", "Mood", "Occasion", "Quality", "Tempo", "Comment", "GroupDesc")
MenuList = Array(UI.Menu_TrayIcon, UI.Menu_Pop_TrackList, UI.Menu_Pop_Tree, UI.Menu_Pop_NP) 'UI.Menu_TbCategorize

...

Erwin Hanzl · Post by **Erwin Hanzl** » Thu Jun 18, 2020 6:09 pm

Open file CusomFieldsTagger with NotePad and add "FieldList" and "FieldListDB" with the entry "Genre":

Sorry, the order was wrong - NEW-NEW-NEW-NEW:

FieldList = Array("Custom1", "Custom2", "Custom3", "Custom4", "Custom5", "Mood", "Occasion", "Quality", "Tempo", "Comment", "Genre","Grouping")
FieldListDB = Array("Custom1", "Custom2", "Custom3", "Custom4", "Custom5", "Mood", "Occasion", "Quality", "Tempo", "Comment", "Genre", "GroupDesc"

Save file
Close NotePad

OPEN MM
Tools> Options> Library .. Custom Fields Tagger - aktivate "Genre"

Darryl_Gittins · Post by **Darryl_Gittins** » Thu Jun 18, 2020 7:30 pm

That worked!

Code: Select all

'==========================================================================
' 
' MediaMonkey Script 
' 
' NAME: CustomFieldsTagger v1.0.3
' DESCRIPTION: 
'  Helps you to quickly tag your custom fields. In the context menu of the
'   selected tracks, for the fields where this is enabled you get a list with
'   possible values from which you can select a value to add/set (depending if
'   you allow multiple values for the custom field or not.) Values that are
'   in the selected field are checked. Values that are not yet used can be
'   added manually to the field, as the selection list only shows used values.
'
' AUTHOR: Steegy
' DATE  : 2011-06-13
' UPDATE: 2011-10-13
'
'==========================================================================

Option Explicit

'==========================================================================
' Set the menu items you want displayed here. The format is :
'    <Field> | <Value> | <Shortcut>
' The field must one of the fields supported by the script
' The shortcut must not already be a defined hotkey in MM
'==========================================================================
Dim MenuItems : MenuItems = Array ("Custom1 | Bonus | Ctrl+1", "Custom1 | Live | Ctrl+2", "Custom1 | Remix | Ctrl+3")


Const SCRIPT_NAME = "CustomFieldsTagger"

Const cftSeparatorMI = -1
Const cftFieldMI = 0
Const cftFixedSubMI = 1
Const cftValueSubMI = 2

Dim UI
Dim INI

Dim MIs

Dim FieldList
Dim FieldListDB
Dim MenuList

Dim NoSelMI
Dim OptionSheetID
Dim Separator




Sub OnStartup

    ' Initialize global variables
    Set UI = SDB.UI
    Set INI = SDB.IniFile
    
    Set MIs = CreateObject("Scripting.Dictionary")
    MIs.CompareMode = 1
    
FieldList = Array("Custom1", "Custom2", "Custom3", "Custom4", "Custom5", "Mood", "Occasion", "Quality", "Tempo", "Comment", "Genre","Grouping")
FieldListDB = Array("Custom1", "Custom2", "Custom3", "Custom4", "Custom5", "Mood", "Occasion", "Quality", "Tempo", "Comment", "Genre", "GroupDesc")
    MenuList = Array(UI.Menu_TrayIcon, UI.Menu_Pop_TrackList, UI.Menu_Pop_Tree, UI.Menu_Pop_NP) 'UI.Menu_TbCategorize
    
    Set NoSelMI = Nothing
    
    ' Set default configuration if missing
    Dim iField, vField
    For iField = 0 To UBound(FieldList)
        vField = FieldList(iField)
        If Not INI.ValueExists(SCRIPT_NAME, vField & "_show") Then INI.BoolValue(SCRIPT_NAME, vField & "_show") = True
        If Not INI.ValueExists(SCRIPT_NAME, vField & "_allowmultiple") Then INI.BoolValue(SCRIPT_NAME, vField & "_allowmultiple") = True
        If Not INI.ValueExists(SCRIPT_NAME, "Separator") Then INI.StringValue(SCRIPT_NAME, "Separator") = "[; ]"
    Next
    
    ' Add menu items
    AddFieldMIs
   
   Dim Itm, Mnu, i, parts
  Set Mnu = UI.AddMenuItemSub( UI.Menu_Edit, -1, -1)
  Mnu.Caption = "Custom Fields Tagger"

   For i = 0 to UBound(MenuItems)
     Set Itm = UI.AddMenuItem( Mnu, -1, -1)
     parts = Split(MenuItems(i), " | ")
     Itm.Caption = parts(0) & " | " & parts(1)
     Itm.UseScript = Script.ScriptPath
     Itm.OnClickFunc = "MenuTag"
     Itm.Shortcut = parts(2)
     Itm.IconIndex = 35
   Next


   

    
    ' Add options sheet
    OptionSheetID = UI.AddOptionSheet("Custom Fields Tagger", Script.ScriptPath, "InitSheet1", "SaveSheet1", -3)
    
    ' Get separator value
    Separator = INI.StringValue(SCRIPT_NAME, "Separator")
    Separator = Mid(Separator, 2, Len(Separator) - 2)
    
End Sub



Sub MenuTag(Item)
   Dim iField, i, parts, IsPres
   parts = Split(Item.Caption, " | ")
   For i = 0 to UBound(FieldList)
     If FieldList(i) = parts(0) Then iField = i
   Next
   
  Dim Tracks : Set Tracks = GetTracks(1)
  If Tracks Is Nothing Or Tracks.Count = 0 Then
        MsgBox "No tracks selected"
      Exit Sub
  End If
   
   IsPres = (IsCustValPresent(Tracks, parts(1), parts(0)) = 1)
   
   AddSetRemoveValue parts(1), 1, iField, IsPres
End Sub



Sub AddFieldMIs

    Dim iMenu, iField, MI, vMenu, vField
    For iMenu = 0 To UBound(MenuList)
        Set vMenu = MenuList(iMenu)
        Set MI = UI.AddMenuItemSep(vMenu, -2, -1)
        MIs.Add MI, Array(iMenu, -1, cftSeparatorMI)
        
        For iField = 0 To UBound(FieldList)
            vField = FieldList(iField)
            
            Set MI = UI.AddMenuItemSub(vMenu, -2, -1)
            If iField < 5 Then
                MI.Caption = INI.StringValue("CustomFields", "Fld" & (iField + 1) & "Name")
            Else
                MI.Caption = SDB.Localize(vField)
            End If
            MI.IconIndex = 25
            MI.Visible = INI.BoolValue(SCRIPT_NAME, vField & "_show")
            Script.RegisterEvent MI, "OnClick", "AddValueSubMIs"
            MIs.Add MI, Array(iMenu, iField, cftFieldMI)
            
            AddFixedSubMIs MI, iMenu, iField
        Next
    Next
    
End Sub


Sub AddFixedSubMIs(FieldMI, iMenu, iField)

    Dim vField : vField = FieldList(iField)
    Dim MI
    
    Set MI = UI.AddMenuItemSep(FieldMI, 0, 0)
    MIs.Add MI, Array(iMenu, iField, cftFixedSubMI)
    
    Set MI = UI.AddMenuItem(FieldMI, 0, 0)
    MI.Caption = "Allow multiple values"
    MI.Checked = INI.BoolValue(SCRIPT_NAME, vField & "_allowmultiple")
    Script.RegisterEvent MI, "OnClick", "ChangeAllowMultiple"
    MIs.Add MI, Array(iMenu, iField, cftFixedSubMI)
    
    Set MI = UI.AddMenuItem(FieldMI, 0, 0)
    MI.Caption = "Add/set value..."
    Script.RegisterEvent MI, "OnClick", "AddManually"
    MIs.Add MI, Array(iMenu, iField, cftFixedSubMI)
    
End Sub


Function GetTracks(iMenu)

    Set GetTracks = Nothing
    
    If iMenu = 0 Then ' Tray menu
        Set GetTracks = SDB.NewSongList
        If Not (SDB.Player.CurrentSong Is Nothing) Then GetTracks.Add(SDB.Player.CurrentSong)
    Else
        Set GetTracks = SDB.CurrentSongList
    End If
    
End Function


Sub AddValueSubMIs(FieldMI)

    Dim Props : Props = MIs.Item(FieldMI)
    Dim iMenu : iMenu = Props(0)
    Dim iField : iField = Props(1)
    Dim vField : vField = FieldList(iField)
    Dim vFieldDB : vFieldDB = FieldListDB(iField)
    Dim MI
    
    ' Remove existing ValueSubMIs
    Dim Keys : Keys = MIs.Keys
    Dim Items : Items = MIs.Items

    For i = UBound(Items) To 0 Step -1
        Props = Items(i)
        If Props(0) = iMenu And Props(1) = iField And Props(2) = cftValueSubMI Then
            Set MI = Keys(i)
            MI.Visible = False
            Script.UnRegisterEvents MI
            MIs.Remove MI
        End If
    Next
    
    ' Remove "<no tracks selected>", if it exists
    If Not NoSelMI Is Nothing Then
        NoSelMI.Visible = False
        Set NoSelMI = Nothing
    End If
    
    ' Check if tracks are selected
    Dim Tracks : Set Tracks = GetTracks(iMenu)
    If Tracks Is Nothing Or Tracks.Count = 0 Then
        Set MI = UI.AddMenuItem(FieldMI, 1, -1)
        MI.Caption = "<no tracks selected>"
        Set NoSelMI = MI
        Exit Sub
    End If
    
    Dim Iter : Set Iter = SDB.Database.OpenSQL("SELECT " & vFieldDB & " FROM Songs GROUP BY " & vFieldDB)
    Dim Sep : Sep = Trim(Separator)
    
    Dim Arr
    Dim oDic : Set oDic = CreateObject("Scripting.Dictionary")
    oDic.CompareMode = 1
    Dim i, Cust
    Do While Not Iter.EOF
        Arr = Split(Iter.StringByIndex(0), Sep)
        For i = 0 To UBound(Arr)
            Cust = Trim(Arr(i))
            If Not oDic.Exists(Cust) Then oDic.Add Cust, ""
        Next
        Iter.Next
    Loop
    
    SortDictionary oDic, dictKey
    
    i = 0
    Dim CustVal, IsPres
    For Each CustVal In oDic.Keys
        i = i + 1
        Set MI = UI.AddMenuItem(FieldMI, 1, -1)
        
        MI.Caption = CustVal
        Script.RegisterEvent MI, "OnClick", "SetCustom"
        MIs.Add MI, Array(iMenu, iField, cftValueSubMI)
        
        IsPres = IsCustValPresent(Tracks, CustVal, vField)

        If IsPres = 0 Then
            MI.Checked = False
        ElseIf IsPres = 1 Then
            MI.Checked = True
        Else
            MI.IconIndex = 35
        End If
    Next
    
End Sub


Const dictKey  = 1
Const dictItem = 2

Function SortDictionary(objDict,intSort)

  ' declare our variables
  Dim strDict()
  Dim objKey
  Dim strKey,strItem
  Dim X,Y,Z

  ' get the dictionary count
  Z = objDict.Count

  ' we need more than one item to warrant sorting
  If Z > 1 Then
    ' create an array to store dictionary information
    ReDim strDict(Z,2)
    X = 0
    ' populate the string array
    For Each objKey In objDict
        strDict(X,dictKey)  = CStr(objKey)
        strDict(X,dictItem) = CStr(objDict(objKey))
        X = X + 1
    Next

    ' perform a a shell sort of the string array
    For X = 0 to (Z - 2)
      For Y = X to (Z - 1)
        If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
            strKey  = strDict(X,dictKey)
            strItem = strDict(X,dictItem)
            strDict(X,dictKey)  = strDict(Y,dictKey)
            strDict(X,dictItem) = strDict(Y,dictItem)
            strDict(Y,dictKey)  = strKey
            strDict(Y,dictItem) = strItem
        End If
      Next
    Next

    ' erase the contents of the dictionary object
    objDict.RemoveAll

    ' repopulate the dictionary with the sorted information
    For X = 0 to (Z - 1)
      objDict.Add strDict(X,dictKey), strDict(X,dictItem)
    Next

  End If

End Function


' 0 = no
' 1 = yes
' 2 = yes/no
Function IsCustValPresent(Tracks, CustVal, vField)
    Dim Sep : Sep = Trim(Separator)
    
    Dim myRegExp : Set myRegExp = New RegExp
    myRegExp.IgnoreCase = True
    
    myRegExp.Global = True
    myRegExp.Pattern = "\-|\+|\*|\?|\!|\%|\(|\)|\[|\]|\<|\>|\\|\||\$|\^"
    CustVal = myRegExp.Replace(CustVal, "\$&")
    Sep = myRegExp.Replace(Sep, "\$&")
    myRegExp.Global = False
    
    Dim CustomContents
    Dim CustValFound, CustValFoundPrevious
    Dim i
    For i = 0 To Tracks.Count - 1
        Execute "CustomContents = Tracks.Item(i)." & vField
        myRegExp.Pattern = "^\s*" & CustVal & "\s*$|^\s*" & CustVal & "\s*" & Sep & "|" & Sep & "\s*" & CustVal & "\s*" & Sep & "|" & Sep & "\s*" & CustVal & "\s*$"
        If myRegExp.Test(CustomContents) Then CustValFound = 1 Else CustValFound = 0
        If i > 0 Then
            If CustValFound <> CustValFoundPrevious Then
                CustValFound = 2    ' Combined yes/no
                Exit For
            End If
        End If
        CustValFoundPrevious = CustValFound
    Next
    
    IsCustValPresent = CustValFound
    
End Function


Sub ChangeAllowMultiple(MI)

    Dim Props : Props = MIs.Item(MI)
    Dim iField : iField = Props(1)
    Dim vField: vField = FieldList(iField)
    
    MI.Checked = Not MI.Checked
    INI.BoolValue(SCRIPT_NAME, vField & "_allowmultiple") = MI.Checked
    
End Sub


Sub AddManually(MI)

    Dim Props : Props = MIs.Item(MI)
    Dim iMenu : iMenu = Props(0)
    Dim iField : iField = Props(1)
    
    Dim TheValue : TheValue = InputBox("Enter the value you want to add/set in the custom field.", "Custom Fields Tagger")
    If Trim(TheValue) <> "" Then
        AddSetRemoveValue TheValue, iMenu, iField, False
    End If
    
End Sub


Sub SetCustom(MI)

    Dim Props : Props = MIs.Item(MI)
    Dim iMenu : iMenu = Props(0)
    Dim iField : iField = Props(1)
    AddSetRemoveValue MI.Caption, iMenu, iField, MI.Checked
    
End Sub


Sub AddSetRemoveValue(TheValue, iMenu, iField, ValuePresent)
    Dim vField : vField = FieldList(iField)
    
    Dim Entry
    Dim AllowMultiple : AllowMultiple = INI.BoolValue(SCRIPT_NAME, vField & "_allowmultiple")
    
    Dim Tracks : Set Tracks = GetTracks(iMenu)
    
    Dim Sep : Sep = Trim(Separator)
    
    Dim CustomContents, Arr, oDic, j, Cust
    Set oDic = CreateObject("Scripting.Dictionary")
    oDic.CompareMode = 1
    Dim i
    For i = 0 To Tracks.Count - 1
        oDic.RemoveAll
    
        Execute "CustomContents = Tracks.Item(i)." & vField
        
        Arr = Split(CustomContents, Sep)
        
        If Not ValuePresent Then ' CustVal not present yet, add it.
            If AllowMultiple Then
                For j = 0 To UBound(Arr)
                    Cust = Trim(Arr(j))
                    oDic.Add Cust, ""
                Next
            End If
            If Not oDic.Exists(TheValue) Then oDic.Add TheValue, TheValue
        Else ' CustVal already present, remove it.
            For j = 0 To UBound(Arr)
                Cust = Trim(Arr(j))
                oDic.Add Cust, Cust
            Next
            oDic.Remove TheValue
        End If
        
        SortDictionary oDic, dictKey
    
        CustomContents = Join(oDic.Keys, Separator)
        Execute "Tracks.Item(i)." & vField & " = CustomContents"
    Next
    Tracks.UpdateAll
End Sub

Sub InitSheet1(Sheet1)

    Dim Label1 : Set Label1 = SDB.UI.NewLabel(Sheet1)
    Label1.Common.SetRect 18,27,400,17
    Label1.Common.ControlName = "Label1"
    Label1.Caption = "Use Custom Fields Tagger for following custom fields:"
    
    Dim iField, vField, chk, ypos
    ypos = 60
    For iField = 0 To UBound(FieldList)
        vField = FieldList(iField)
        Set chk = SDB.UI.NewCheckBox(Sheet1)
        If iField < 5 Then
            chk.Caption = INI.StringValue("CustomFields", "Fld" & (iField + 1) & "Name")
        Else
            chk.Caption = SDB.Localize(vField)
        End If
        chk.Checked = SDB.IniFile.BoolValue(SCRIPT_NAME, vField & "_show")
        chk.Common.SetRect 40,ypos,100,20
        chk.Common.ControlName = "Show" & vField
        ypos = ypos + 20
    Next
    
    Dim Label2 : Set Label2 = UI.NewLabel(Sheet1)
    Label2.Autosize = False
    Label2.Common.SetRect 33,360,70,21
    Label2.Common.ControlName = "Label2"
    Label2.Caption = "Separator:"
    
    Dim Edit1 : Set Edit1 = UI.NewEdit(Sheet1)
    Edit1.Common.SetRect 95,357,20,21
    Edit1.Common.ControlName = "Separator"
    Edit1.Text = Separator
    
End Sub


Sub SaveSheet1(Sheet1)

    Dim iMenu, iField, MI, vMenu, vField, Show
    
    Dim Keys : Keys = MIs.Keys
    Dim Items : Items = MIs.Items
    Dim Props, i
    
    For iField = 0 To UBound(FieldList)
        vField = FieldList(iField)
        Show = Sheet1.Common.ChildControl("Show" & vField).Checked
        INI.BoolValue(SCRIPT_NAME, vField & "_show") = Show
        
        For iMenu = 0 To UBound(MenuList)
            Set vMenu = MenuList(iMenu)
            
            For i = 0 To UBound(Items)
                Props = Items(i)
                If Props(0) = iMenu And Props(1) = iField And Props(2) = cftFieldMI Then
                    Set MI = Keys(i)
                    MI.Visible = Show
                End If
            Next
        Next
    Next
    
    Separator = Sheet1.Common.ChildControl("Separator").Text
    INI.StringValue(SCRIPT_NAME, "Separator") = "[" & Separator & "]"
    
End Sub


Sub Uninstall

    DoCleanup
    
    Dim MsgDeleteSettings : MsgDeleteSettings = "Uninstalling " & SCRIPT_NAME & "." & vbNewLine & _
                                     "Do you want to remove the settings as well?" & vbNewLine & _
                                                "If you click No, script settings will be left in MediaMonkey.ini"
                                                
    If (Not INI Is Nothing) and (MsgBox(MsgDeleteSettings, vbYesNo, SCRIPT_NAME) = vbYes) Then
       INI.DeleteSection(SCRIPT_NAME)
    End If

End Sub


Sub DoCleanup

    If IsEmpty(OptionSheetID) Then Exit Sub
    
    SDB.UI.DeleteOptionSheet OptionSheetID
    
    Dim MI
    For Each MI In MIs.Keys
        MI.Visible = False
    Next
    Set MIs = Nothing
    
    Script.UnRegisterAllEvents

End Sub

Genre Sorting

Genre Sorting

Re: Genre Sorting

Re: Genre Sorting

Re: Genre Sorting

Re: Genre Sorting

Re: Genre Sorting