Re: CustomFieldsTagger v1.0.1 [MM3+4]
Posted: Mon Sep 12, 2011 11:19 pm
Thanks Steegy for this awesome script. I had used a similar script years ago but your implementation is wonderful. The only thing I thought it was missing for myself was the ability to add hotkeys for values that are commonly used. I updated the script to add a submenu in the edit menu. And in the top of the script there is a line where the user can customize the menu items (ie. fields, values, and shortcuts) that they want. The update works for me, but you may want to test it out as well. So, I just added menu items in the OnStartup and added the MenuTag sub.
Code: Select all
'==========================================================================
'
' MediaMonkey Script
'
' NAME: CustomFieldsTagger v1.0.1
' 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-06-18
'
'==========================================================================
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 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", "Comment")
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 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 " & vField & " FROM Songs GROUP BY " & vField)
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"
Tracks.Item(i).UpdateDB
Next
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,260,70,21
Label2.Common.ControlName = "Label2"
Label2.Caption = "Separator:"
Dim Edit1 : Set Edit1 = UI.NewEdit(Sheet1)
Edit1.Common.SetRect 95,257,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