Here's some additions which can be made to the .ini *YOU MAY NEED TO CHANGE THE ORDER NUMBERS SO THEY DON'T CONFLICT WITH YOUR OWN .INI
Code: Select all
[BackupClassificationToCustom3]
FileName=Custom Scripts.vbs
ProcName=BackupClassificationToCustom3
Order=6
DisplayName=Change the Classification String
Description=Change the Classification String
Language=VBScript
ScriptType=0
[AddCategoryToCustom1]
FileName=Custom Scripts.vbs
ProcName=AddCategoryToCustom1
Order=8
DisplayName=Add a Category
Description=Add a Category
Language=VBScript
ScriptType=0
[RemoveCategoryFromCustom1]
FileName=Custom Scripts.vbs
ProcName=RemoveCategoryFromCustom1
Order=12
DisplayName=Remove a Category
Description=Remove a Category
Language=VBScript
ScriptType=0
[ReplaceStringInField]
FileName=Custom Scripts.vbs
ProcName=ReplaceStringInField
order=48
DisplayName=*Replace a String in a Field
Description=Replace a String in a Field
Language=VBScript
ScriptType=0
[ModifyField]
FileName=Custom Scripts.vbs
ProcName=ModifyField
Order=49
DisplayName=*Modify a field
Description=Modify a field
Language=VBScript
ScriptType=0
[SwapFields]
FileName=Custom Scripts.vbs
ProcName=SwapFields
Order=50
DisplayName=*Swap Two Fields
Description=Swap Two Fields
Language=VBScript
ScriptType=0
[AddValueToTrackNum]
FileName=Custom Scripts.vbs
ProcName=AddValueToTrackNum
Order=99
DisplayName=Add a value to the track#
Description=Add a value to the track#
Language=VBScript
ScriptType=0
AddCategoryToCustom1 will take a string and add it to the end of custom1 including proper comma separation. With winamp I used the comment field to store categories for my music, but with MM I stick them in custom1 so I can search on keywords. It will not add a string if the string already exists in custom1. Just type in the string to add without any commas.
RemoveCategoryFromCustom1 will remove a comma separated string while maintaining the rest of the categories. Just type in the string to remove without any commas.
ReplaceStringInField will request a field (given below), a string to replace, and the string to replace it with. White space is included in the strings
ModifyField requests a field and then a new value for the field. The difference is that it overwrites the entire field and it can take other fields as arguments (in <>). For example, enter the field "TITLE" and then replace it with "<TRACK#>. <TITLE>" and you'll end up with a title such as "11. Free Falling".
SwapFields requests 2 fields and then swaps the contents.
AddValueToTrackNum requests a numeric value and then adds that to the track. I use this mainly for multi-disc albums so I can either add 100 & 200 to the track numbers or just add a number to the second disc's tracks.
Here's the fields
ARTIST
TRACK#
TITLE
ALBUM
ALBUMARTIST
CUSTOM1
CUSTOM2
CUSTOM3
GENRE
COMMENT *added 11/10
PATH *added 2/1/8, thx Roger. WKW
TEMPO *added 2/2/8. WKW
MOOD *added 2/2/8. WKW
OCCASION *added 2/2/8. WKW
QUALITY *added 2/2/8. WKW
Here's the messy code for these functions.
Code: Select all
Dim ClassificationDict, FieldDict
Set ClassificationDict = CreateObject("Scripting.Dictionary")
With ClassificationDict
.Add "TEMPO", "1"
.Add "MOOD", "2"
.Add "OCCASION", "3"
.Add "QUALITY", "4"
End With
Set FieldDict = CreateObject("Scripting.Dictionary")
With FieldDict
.Add "<ARTIST>", "ArtistName"
.Add "<TRACK#>", "TrackOrder"
.Add "<TITLE>", "Title"
.Add "<ALBUM>", "AlbumName"
.Add "<ALBUMARTIST>", "AlbumArtistName"
.Add "<CUSTOM1>", "Custom1"
.Add "<CUSTOM2>", "Custom2"
.Add "<CUSTOM3>", "Custom3"
.Add "<GENRE>", "Genre"
.Add "<PATH>", "Path" 'comment field added 2/2/8, thanks again Roger. WKW
.Add "<COMMENT>", "Comment" 'comment field added by request, Thanx Rogerr
.Add "<TEMPO>", "Tempo"
.Add "<MOOD>", "Mood"
.Add "<OCCASION>", "Occasion"
.Add "<QUALITY>", "Quality"
'last four were added 2/2/8 and not been checked. Due to new access methods in MM. WKW
End With
Function Cond(test, a, b) ' Returns a if test evaluates to true, b otherwise
If test Then
Cond = a
Else
Cond = b
End If
End Function
Function CurrentVersion
CurrentVersion = 100 * SDB.VersionHi + SDB.VersionLo
End Function
Function SkinnedInputBox(text, caption, input)
Dim Form, Label, Edt, btnOk, btnCancel, modalResult
' Create the window to be shown
Set Form = SDB.UI.NewForm
Form.Common.SetRect 100, 100, 360, 130
Form.BorderStyle = 2 ' Resizable
Form.FormPosition = 4 ' Screen Center
Form.SavePositionName = "Remember position"
Form.Caption = caption
' Create a button that closes the window
Set Label = SDB.UI.NewLabel(Form)
Label.Caption = text
Label.Common.Left = 5
Label.Common.Top = 10
Set Edt = SDB.UI.NewEdit(Form)
Edt.Common.Left = Label.Common.Left
Edt.Common.Top = Label.Common.Top + Label.Common.Height + 5
Edt.Common.Width = Form.Common.Width - 20
Edt.Common.ControlName = "Edit1"
Edt.Common.Anchors = 1+2+4 'Left+Top+Right
Edt.Text = Input
' Create a button that closes the window
Set BtnOk = SDB.UI.NewButton(Form)
BtnOk.Caption = "&OK"
BtnOk.Common.Top = Edt.Common.Top + Edt.Common.Height + 10
BtnOk.Common.Hint = "OK"
BtnOk.Common.Anchors = 4 ' Right
BtnOk.UseScript = Script.ScriptPath
If currentVersion() >= 204 Then BtnOk.Default = True
BtnOk.ModalResult = 1
Set BtnCancel = SDB.UI.NewButton(Form)
BtnCancel.Caption = "&Cancel"
BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width - 15
BtnOK.Common.Left = BtnCancel.Common.Left - BtnOK.Common.Width - 10
BtnCancel.Common.Top = BtnOK.Common.Top
BtnCancel.Common.Hint = "Cancel"
BtnCancel.Common.Anchors = 4 ' Right
BtnCancel.UseScript = Script.ScriptPath
If currentVersion() >= 204 Then BtnCancel.Cancel = True
BtnCancel.ModalResult = 2
modalResult = Form.showModal
SkinnedInputBox = Cond(modalResult=1, Edt.Text, "")
End Function
'-------------------------------------------------------------------------
'These functions are building blocks to create and execute scripts
Function kwToCommand(statement)
'replaces data fields with proper references for execution
Dim i, fields
fields = FieldDict.Keys
For i = 0 To FieldDict.Count - 1
statement = Replace(statement, fields(i), "itm."&FieldDict.Item(fields(i)))
Next
kwToCommand = statement
End Function
Function kwToStringStatement(statement)
Dim i, fields
fields = FieldDict.Keys
For i = 0 To FieldDict.Count - 1
statement = Replace(statement, fields(i), Chr(34)&"&itm."&FieldDict.Item(fields(i))&"&"&Chr(34) )
Next
kwToStringStatement = statement
End Function
Function kwToString(s)
kwToString = Chr(34)&s&Chr(34)
End Function
Function kwToField(s)
kwToField = "<"&s&">"
End Function
Function kwExecuteStatement(statement)
'run a script on each selected track
Dim list, itm, i
' If (SDB.MessageBox( "Execute: "&Chr(34)&statement&Chr(34)&"?", mtConfirmation, Array(mbYes, mbNo)) = mrNo) Then Exit Function
Set list = SDB.SelectedSongList
If list.count=0 Then
Set list = SDB.AllVisibleSongList
End If
If(Replace(UCase(statement),"UPDATEDB","") = UCase(statement)) Then statement = statement & ":itm.UpdateDB"
' Process all selected tracks
For i=0 To list.count-1
Set itm = list.Item(i)
Execute statement
Next
End Function
'---------------------------------------------------------------
'These are generic functions for manipulation of data
'The "kwCommand" functions build a "script" to be executed
'on each selected entry and the following subroutines are
'the interfaces to build those commands from user input
Function kwCommandSwapFields(field1, field2)
Dim s
' Build the statement to swap fields
s = "tmp = field1:"
s = s & "field1 = field2:"
s = s & "field2 = tmp:"
s = s & "itm.UpdateDB"
s = Replace(s, "field1", field1)
s = Replace(s, "field2", field2)
s = kwToCommand(s)
kwCommandSwapFields = s
End Function
Sub SwapFields
Dim field1, field2
field1 = UCase(SkinnedInputBox("Enter field1", "", "ALBUM"))
if (field1 = "") then
Exit Sub
End If
field2 = UCase(SkinnedInputBox("Enter field2", "", "ARTIST"))
if (field2 = "") then
Exit Sub
End If
kwExecuteStatement kwCommandSwapFields(kwToField(field1), kwToField(field2))
End Sub
Function kwCommandModifyField(field, s)
s = kwToStringStatement(s)
s = field&" = "&kwToString(s)&":itm.UpdateDB"
s = kwToCommand(s)
kwCommandModifyField = s
End Function
Sub ModifyField
Dim s, field
field = UCase(SkinnedInputBox("Enter field", "", "TITLE"))
if (field = "") then
Exit Sub
End If
s = UCase(SkinnedInputBox("Enter new field", "", "<TITLE>"))
if (s = "") then
Exit Sub
End If
kwExecuteStatement kwCommandModifyField(kwToField(field), s)
End Sub
Sub AddCategoryToCustom1
' Define variables
Dim category, s
category = Trim(SkinnedInputBox("Enter the Category to add", "Add Category", ""))
if (category = "") then
Exit Sub
End If
s = s & " If(itm.Custom1 = '''') Then:"
s = s & " itm.Custom1 = category:"
s = s & " itm.UpdateDB:"
s = s & " Else If(InStr(LCase(itm.Custom1), LCase(category)) = 0) Then:"
s = s & " itm.Custom1 = itm.Custom1 & '', '' & category:"
s = s & " itm.UpdateDB:"
s = s & " End If"
s = Replace(s, "''", Chr(34))
kwExecuteStatement Replace(s, "category", kwToString(category))
End Sub
Function kwCommandReplaceStringInField(field, s, s2)
kwCommandReplaceStringInField = kwToCommand( field&" = Replace("&field&", "&kwToString(s)&", "&kwToString(s2)&")" )
End Function
Sub ReplaceStringInField
Dim s, s2, field
field = UCase(SkinnedInputBox("Enter field", "", "TITLE"))
if (field = "") then
Exit Sub
End If
s = SkinnedInputBox("Enter string to replace", "", "")
if (s = "") then
Exit Sub
End If
s2 = SkinnedInputBox("Enter new string", "", "")
if (s = "") then
Exit Sub
End If
kwExecuteStatement kwCommandReplaceStringInField(kwToField(field), s, s2)
End Sub
Sub RemoveCategoryFromCustom1
' Define variables
Dim category, s
category = Trim(SkinnedInputBox("Enter the Category to remove", "Remove Category", "Blah"&Chr(34)))
if (category = "") then
Exit Sub
End If
s = "If(itm.Custom1 = Category) Then:"
s = s & " itm.Custom1 = '''':"
s = s & " itm.UpdateDB:"
s = s & "End If:"
' s = s & "itm.Custom1 = Replace(itm.Custom1, '', ''&Category&'', '', '', ''):" 'line removed 2/1/8, error found by jd776. WKW
s = s & "itm.Custom1 = Replace(itm.Custom1, Category&'', '', ''''):"
s = s & "itm.Custom1 = Replace(itm.Custom1, '', ''&Category, ''''):"
s = s & "itm.UpdateDB:"
s = Replace(s, "''", Chr(34))
kwExecuteStatement Replace(s, "Category", kwToString(Category))
End Sub
Sub AddValueToTrackNum
' Define variables
Dim value, s
value = Trim(SkinnedInputBox("Add how much?", "Add To Track#", ""))
if (value = "") then
Exit Sub
End If
s = " itm.TrackOrder = itm.TrackOrder + value:"
s = s & " itm.UpdateDB"
kwExecuteStatement Replace(s, "value", value)
End Sub
'--------------------------------------------------------------------------
'these are SQL statements, which aren't worth using the kwExecuteStatement
Sub SynchronizeCustom1
' Define variables
Dim list, iter, itm, i, query
' Get list of selected tracks from MediaMonkey
Set list = SDB.SelectedSongList
If list.count=0 Then
Set list = SDB.AllVisibleSongList
End If
' Process all selected tracks
For i=0 To list.count-1
Set itm = list.Item(i)
query = "SELECT DISTINCT Custom1 FROM Songs WHERE Songs.ID<>"&itm.ID&" AND IDAlbum="&itm.Album.ID&" AND IDArtist="&itm.Artist.ID&" AND SongTitle='"&Replace(itm.Title,"'","''")&"'"
' SDB.MessageBox query, mtError, Array(mbOk)
Set iter = SDB.Database.OpenSQL(query)
' Copy custom1
itm.Custom1 = iter.StringByName("Custom1")
' Update the changes in DB
itm.UpdateDB
Iter.next
Next
End Sub
'------------------------------
'This can be cleaned up some day due to new ways to access the classifications. It'd probably be faster than repeated DB queries, but this way seems to still work fine. WKW
'------------------------------
Function kwBackupClassificationToField(classification, field)
Dim i, itm, iter, list
' Get list of selected tracks from MediaMonkey
Set list = SDB.SelectedSongList
If list.count=0 Then
Set list = SDB.AllVisibleSongList
End If
' Process all selected tracks
For i=0 To list.count-1
Set itm = list.Item(i)
Set iter = SDB.Database.OpenSQL("SELECT Lists.TextData FROM Songs,AddSongInfoInt,Lists WHERE Lists.idListType = "&ClassificationDict.Item(classification)&" AND Lists.Id = AddSongInfoInt.intData AND AddSongInfoInt.idSong = "&itm.ID)
' Swap the fields
Execute kwToCommand( field&" = Iter.StringByName("&kwToString("TextData")&")" )
' Update the changes in DB
itm.UpdateDB
iter.next
Next
End Function
Sub BackupClassificationToCustom3
' Define variables
Dim classification
classification = UCase(SkinnedInputBox("Enter the classification to back up", "Define Classification", "MOOD"))
if (classification = "") then
Exit Sub
End If
kwBackupClassificationToField classification, "<CUSTOM3>"
End Sub