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