Code: Select all
' MediaMonkey Script
'
' NAME: CaseModify
'
' AUTHOR: Originally by Risser and modified by Bex
' DATE : 2007-01-24
'
' INSTALL, Two different ways:
'
' ** Update existing Case script (wich is shipped with MM) **
' 1) Goto "Mediamonkey\Scripts" folder. Open up the existing script named Case.vbs in e.g. Notepad
' 2) Replace all the code in the file with this code
' 3) (Re)start MediaMonkey
'
' ** Separate Install, which will work independently of the Case script **
' 1) Goto "Mediamonkey\Scripts" folder. Right click and create a txt file.
' 2) Name it CaseModify.vbs (Make sure it's not named CaseModify.vbs.txt)
' 3) Copy all this content into the file and save it.
' 4) Open up the scripts.ini file located in the same folder and add the text below to the end of the file
'[CaseModify]
'FileName=CaseModify.vbs
'ProcName=TitleCase
'Order=10
'DisplayName=Case Modify...
'Description=
'Language=VBScript
'ScriptType=0
'Shortcut=Ctrl+E
' 5) Remove all the ' from the text you just pasted into the script.ini file
' 6) Save the file and (Re)start MediaMonkey
'
'////////////////////////////////////////////////////////////////////////////////
' ////////////////// Rissers original notes below ///////////////////////////////
'////////////////////////////////////////////////////////////////////////////////
' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'
' "TitleCase.vbs", Jun-21-2005, v2.00
' VBScript for MediaMonkey 2.3.1 (or above), written by Risser
'
' Purpose:
' - To update case on Artist, Album Artist, Album and Song Title fields.
'
' Notes:
' - This script writes tags then immediately updates the DB. There is no
' impact on the DB for tracks that are not part of the library (particularly,
' the tracks are not auto-added to the library)
' - If you update an Artist name or an Album name, it updates the name in the
' database and this change is reflected for all instances of that name, even
' if it wasn't one of the selected tracks.
' - It's pretty smart about the location of punctuation, roman numerals, foreign contractions
' (d', l', etc.), initials, cardinal numbers (1st, 40th), years (1950s, 1960's) and words with
' no vowels, but it's not perfect.
' - There are also two pipe-separated (|) lists of words. One is a "little" words list, like "the",
' "an", "a", "of" etc. If there's a word you'd like treated like a little word (maybe "on" or
' "by", or other words if your tags aren't english), add it to the list.
' - The second list is a list of "forced-case" words. If the parser sees this word in any case, it
' replaces it with the word in the list, making it exactly that case. This is good for acronyms
' with vowels (BTO, REM, ELO; CCR and CSN have no vowels, so they are auto-uppercased), things that
' need to stay lower case, or abbreviations with no vowels that should be uppercase, like Dr, Mr,
' Mrs, St, etc. Feel free to change these lists to match your collection.
' - It treats apostrophes as a letter, so these can be included in a word. For example, for "James
' Brown and the JB's", I have "JB's" and "JBs" in my forced case list.
' - Also, on the forced case list, you can specify a final piece of punctuation. Thus, I have "w/",
' which will lowercase "w/", but leave "W" alone to be uppercase. Also, I have "silence]" which
' will force that configuration to be lowercase (for tracks that are all silence), but will treat
' "Silence" normally.
'
' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
Option Explicit
Dim littleWordString
littleWordString = "a|an|and|at|de|del|di|du|e|el|en|et|for|from|la|le|in" & _
"|n|'n|n'|'n'|o'|'o'|of|or|por|the|to|un|une|und|with|y"
Dim forceCapString
forceCapString = "AC|EBN|OZN|MCs|MC's|DJs|DJ's|JBs|JB's|10cc|Mr|Mrs|Dr|Jr|Sr|Pt|St.|St"& _
"|vs|ft|feat|aka|vol|w/|ABC|ABCs|AC/|ASCII|ASCIII|ATV|BTO|ELO|ELP|EMI|DuShon" & _
"|FYC|INXS|MacArthur|OMC|OMD|OMPS|PSI|PTA|REM|REO|Sgt|UB40|UK|USA|USMC|UTFO" & _
"|silence]|T's|OK|USSR|ATB|ATFC|UDG|VA|OHM|DAD|I'll|BBE|Li|EP|SOS|UHU|DAF" & _
"|aac|aif|aifc|ape|apl|fla|flac|iff|ivf|m4a|mac|mp+|mp1" & _
"|mp2|mp3|mp3pro|mp4|mpc|mpe|mpp|mpv2|mt2|ogg|rmp|shn|snd" & _
"|svx|wav|vlb|wma|vob|voc|vox|wv|vqf" & _
"|LNQ|FPI|pres.|vs.|ft.|vol."
Dim res
Dim alphaNum, whiteSpace, isMc, vowels, romanNumerals, cardinal, isForeignPref
Set alphaNum = new regExp
Set whiteSpace = new regExp
Set isMc = new regExp
Set vowels = new regExp
Set romanNumerals = new RegExp
Set cardinal = new RegExp
Set isForeignPref = new RegExp
alphaNum.ignoreCase = True
alphaNum.pattern = "['`´A-Za-z0-9" & ChrW(192) & "-" & ChrW(65276) & "]"
whiteSpace.pattern = "^[\s,&]+$" 'include comma, ampersand, because we don't want to cap after these
isMc.ignoreCase = True
isMc.pattern = "^(O['`]|MC)" ' handle O'Brien and McHenry
isForeignPref.ignoreCase = True
isForeignPref.pattern = "^([dl]|dell)['`]" ' handle l', d' and dell'
vowels.ignoreCase = True
vowels.pattern = "[AEIOUY" & ChrW(192) & "-" & ChrW(601) & "]"
romanNumerals.ignoreCase = True
romanNumerals.pattern = "^M*(C(M|D)|D?C{0,3})(X(C|L)|L?X{0,3})(I(X|V)|V?I{0,3})$"
cardinal.ignoreCase = True
cardinal.pattern = "^\d*(1st|2nd|3rd|[0-9]th|[0-9]['`]?s)$" 'also handles years, like 1950s
Dim littleWordList
littleWordList = Split(littleWordString,"|")
Dim forceCapList
forceCapList = Split(forceCapString,"|")
Public holdArtist, holdAlbum, holdTitle, holdAlbumArtist, holdFileName
Set holdArtist = CreateObject("Scripting.Dictionary")
Set holdAlbum = CreateObject("Scripting.Dictionary")
Set holdTitle = CreateObject("Scripting.Dictionary")
Set holdAlbumArtist = CreateObject("Scripting.Dictionary")
Set holdFileName = CreateObject("Scripting.Dictionary")
Const mmAnchorRight = 4
Const mmAnchorBottom = 8
Const mmAlignTop = 1
Const mmAlignBottom = 2
Const mmAlignClient = 5
Const mmListDropdown = 2
Const mmFormScreenCenter = 4
Public styleOn
Function Style()
styleOn = Not styleOn
If styleOn Then
Style = ""
Else
Style = " class=""Dark"""
End If
End Function
Function rdQS(UnquotedString)
rdQS = "'" & Replace(UnquotedString, "'", "''") & "'"
End Function
Function uppercase(s)
If Left(s,1) = "'" And Len(s) > 1 Then
uppercase = Left(s,1)&UCase(Mid(s,2,1))&LCase(Mid(s,3))
Else
uppercase = UCase(Mid(s,1,1))&LCase(Mid(s,2))
End If
End Function
Function fixUp(s, prevChars, nextChar)
Dim forceIndex, littleIndex, i
Dim capMe, allCaps, foreignPref
Dim upcased, littleUpped, forceUpped
forceIndex = -1
littleIndex = -1
capMe = false
allCaps = false
upcased = UCase(s)
foreignPref = isForeignPref.test(s)
For i = 0 to UBound(forceCapList)
forceUpped = UCase(forceCapList(i))
If UCase(forceCapList(i)) = upcased Or forceUpped = upcased & nextChar Then
forceIndex = i
Exit For
End If
Next 'i
For i = 0 to UBound(littleWordList)
littleUpped = UCase(littleWordList(i))
If littleUpped = upcased Or littleUpped = upcased & nextChar Then
littleIndex = i
Exit For
End If
Next 'i
If forceIndex >= 0 Then
s = forceCapList(forceIndex)
Else
If Len(s) = 1 And nextChar = "." Then
' if it's a single character followed by a period (an initial), caps it
allCaps = True
ElseIf Not vowels.test(s) And Not cardinal.test(s) Then
' if it's all consonants, no vowels, and not a cardinal number, caps it
allCaps = True
ElseIf romanNumerals.test(s) And UCase(s) <> "MIX" And UCase(s) <> "MI" And UCase(s) <> "DI" Then
' if it's roman numerals (and not 'mix' or 'di' which are valid roman numerals), caps it
allCaps = True
ElseIf prevChars = "" Or (nextChar = "" And Not foreignPref) Then
'if it's the first or last word, cap it
capMe = True
ElseIf Not whiteSpace.test(prevChars) Or (nextChar <> "" And InStr(")}]",nextChar)) Then
' if it follows a punctuation mark (with or without spaces) or if it's before a close-bracket, cap it
capMe = True
ElseIf littleIndex < 0 And Not foreignPref Then
' if it's not on the 'little word' list, cap it
capMe = True
End If
If allCaps Then
s = UCase(s)
ElseIf capMe Then
s = uppercase(s)
Else
s = LCase(s)
End If
If isMc.Test(s) And Len(s) > 2 Then
' if it's Mc or O', cap the 3rd character (this assumes no names like McA)
s = Mid(s,1,2)&UCase(Mid(s,3,1))&LCase(Mid(s,4))
End If
If foreignPref Then
' if it's l', d' or dell', lowercase the first letter and uppercase the first letter after the apostrophe
Dim pos
pos = InStr(s,"'")
If pos < 1 Then
pos = InStr(s,"`")
End If
If pos > 0 And pos < Len(s) Then
s = Mid(s,1,pos)&UCase(Mid(s,pos+1,1))&LCase(Mid(s,pos+2))
End If
End If
End If
fixUp = s
End Function
Function updateCase(s)
Dim currentWord, result, fixed, theChar, lastNonWordChars
Dim forceIndex
Dim i
currentWord = ""
result = ""
lastNonWordChars = ""
For i = 1 to Len(s)
theChar = Mid(s,i,1)
If alphaNum.test(theChar) Then
currentWord = currentWord & theChar
Else
If currentWord <> "" Then
fixed = fixUp(currentWord,lastNonWordChars,theChar)
If Right(fixed,1) = theChar Then 'handle stuff like w/
fixed = Left(fixed,Len(fixed)-1)
lastNonWordChars = ""
Else
lastNonWordChars = theChar
End If
result = result & fixed
currentWord = ""
Else
lastNonWordChars = lastNonWordChars & theChar
End If
result = result & theChar
End If
Next 'i
If Len(currentWord) > 0 Then
result = result & fixUp(currentWord,lastNonWordChars,"")
End If
updateCase = result
End Function
Sub CloseDown
Set holdAlbum = nothing
Set holdAlbumArtist = nothing
Set holdArtist = nothing
Set holdTitle = Nothing
Set holdFileName = Nothing
SDB.Objects("CaseThingy") = Nothing
SDB.Objects("holdArtist") = Nothing
SDB.Objects("holdAlbumArtist") = Nothing
SDB.Objects("holdAlbum") = Nothing
SDB.Objects("holdTitle") = Nothing
SDB.Objects("holdFileName") = Nothing
End Sub
Sub OnCancel(Btn)
CloseDown
End Sub
Sub OnOK(Btn)
Set holdAlbum = SDB.Objects("holdAlbum")
Set holdAlbumArtist = SDB.Objects("holdAlbumArtist")
Set holdArtist = SDB.Objects("holdArtist")
Set holdTitle = SDB.Objects("holdTitle")
Set holdFileName = SDB.Objects("holdFileName")
Dim itm, str, sql
Dim items, albumNames, artistNames, fileNames
Set items = CreateObject("Scripting.Dictionary")
Set albumNames = CreateObject("Scripting.Dictionary")
Set artistNames = CreateObject("Scripting.Dictionary")
Set fileNames = CreateObject("Scripting.Dictionary")
For Each itm In holdArtist
str = holdArtist.item(itm)
If Not items.exists(itm) Then
items.add itm, itm
End If
itm.artistName = str
If Not artistNames.exists(str) Then
sql = "UPDATE Artists SET Artists.Artist = " & rdQS(str) & " WHERE Artists.Artist= " & rdQS(Itm.ArtistName)
SDB.database.execSQL(sql)
' This will affect ALL instances of this artist, including album artist, and on other tracks.
artistNames.add str, str
End If
Next 'itm
For Each itm In holdAlbumArtist
str = holdAlbumArtist.item(itm)
If Not items.exists(itm) Then
items.add itm, itm
End If
itm.albumArtistName = str
If Not artistNames.exists(str) Then
sql = "UPDATE Artists SET Artists.Artist = " & rdQS(str) & " WHERE Artists.Artist= " & rdQS(Itm.ArtistName)
SDB.database.execSQL(sql)
artistNames.add str, str
End If
Next 'itm
For Each itm In holdAlbum
str = holdAlbum.item(itm)
If Not items.exists(itm) Then
items.add itm, itm
End If
itm.albumName = str
If Not albumNames.exists(str) Then
sql = "UPDATE Albums SET Albums.Album = " & rdQS(str) & " WHERE Albums.Album= " & rdQS(Itm.AlbumName)
SDB.database.execSQL(sql)
' This will affect ALL instances of this album, including other tracks.
albumNames.add str, str
End If
Next 'itm
For Each itm In holdTitle
str = holdTitle.item(itm)
If Not items.exists(itm) Then
items.add itm, itm
End If
itm.title = str
Next 'itm
For Each itm In holdFileName
str = holdFileName.item(itm)
If Not items.exists(itm) Then
items.add itm, itm
End If
itm.path = Left(itm.path,InStrRev(itm.path,"\")) & str
Next 'itm
Dim list
Set list = SDB.NewSongList
For Each itm In items
list.Add( itm)
Next
list.UpdateAll
Set items = nothing
CloseDown
End Sub
Function MapXML(original)
Dim hold
hold = Replace(original, "&", "&")
hold = Replace(hold, " ", " ")
hold = Replace(hold, "<", "<")
hold = Replace(hold, ">", ">")
hold = Replace(hold, """", """)
Dim i
i=1
While i<=Len(hold)
If (AscW(Mid(hold, i, 1))>127) Then
hold = Mid(hold, 1, i-1)+"&#"+CStr(AscW(Mid(hold, i, 1)))+";"+Mid(hold, i+1)
End If
i=i+1
WEnd
MapXML = hold
End Function
Function MapField(fld)
If fld="" Then
MapField = " "
Else
MapField = MapXML(fld)
End If
End Function
Function outField (fixed, normal)
If fixed = normal Then
outField = "<td>" & MapField(normal) & "</td>" & vbcrlf
Else
outField = "<td class=""highlight"" title=""" & SDB.Localize("Old Value: ") & Chr(13) & MapXML(normal) & """>" & MapField(fixed) & "</td>" & vbcrlf
End If
End Function
Sub TitleCase
Dim UI, Form, Foot, Btn, Btn2, WB, HTML
Dim trackList
Dim writeChanges
dim DlgWidth
Set trackList = SDB.CurrentSongList
If trackList.count=0 Then
res = SDB.MessageBox("Select tracks to be updated", mtError, Array(mbOk))
Exit Sub
End If
Set UI = SDB.UI
DlgWidth = 500
' Create the window to be shown
Set Form = UI.NewForm
Form.Common.SetRect 50, 50, DlgWidth, 400
Form.Common.MinWidth = 200
Form.Common.MinHeight = 150
Form.FormPosition = mmFormScreenCenter
Form.Caption = SDB.Localize("Case Checker")
Form.StayOnTop = True
' Create a web browser component
Set WB = UI.NewActiveX(Form, "Shell.Explorer")
WB.Common.Align = mmAlignClient ' Fill all client rectangle
WB.Common.ControlName = "WB"
' Create a panel at the bottom of the window
Set Foot = UI.NewPanel(Form)
Foot.Common.Align = mmAlignBottom
Foot.Common.Height = 35
' Create a button that saves the report
Set Btn2 = UI.NewButton(Foot)
Btn2.Caption = SDB.Localize("&Ok")
Btn2.Common.SetRect DlgWidth - 205, 6, 85, 25
Btn2.Common.Anchors = mmAnchorRight + mmAnchorBottom
Btn2.UseScript = Script.Scriptpath
Btn2.OnClickFunc = "OnOK"
Btn2.Default = true
' Create a button that closes the window
Set Btn = UI.NewButton(Foot)
Btn.Caption = SDB.Localize("&Cancel")
Btn.Common.SetRect DlgWidth - 105, 6, 85, 25
Btn.Common.Anchors = mmAnchorRight + mmAnchorBottom
Btn.UseScript = Script.Scriptpath
Btn.OnClickFunc = "OnCancel"
Btn.Cancel = true
Form.SavePositionName = "CaseWindow"
Form.Common.Visible = True ' Only show the form, don't wait for user input
SDB.Objects("CaseThingy") = Form ' Save reference to the form somewhere, otherwise it would simply disappear
HTML = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & vbcrlf
HTML = HTML & "<html>" & vbcrlf
HTML = HTML & " <head>" & vbcrlf
HTML = HTML & " <title>" & SDB.Localize("Case Checker") & "</title>" & vbcrlf
HTML = HTML & " </head>" & vbcrlf
HTML = HTML & "<STYLE TYPE=text/css>" & vbcrlf
HTML = HTML & "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}" & vbcrlf
HTML = HTML & "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-align:left}" & vbcrlf
HTML = HTML & "P{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000;}" & vbcrlf
HTML = HTML & "TH{font-family:'Verdana',sans-serif; font-size:9pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}" & vbcrlf
HTML = HTML & "TD{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf
HTML = HTML & "TD.highlight{font-family:'Verdana',sans-serif; font-size:8pt; background-color:#FFFF77; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf
HTML = HTML & "TR.dark{background-color:#EEEEEE}" & VbCrLf
HTML = HTML & "TR.aleft TH{text-align:left}" & vbcrlf
HTML = HTML & "</STYLE>" & vbcrlf
HTML = HTML & " <body>" & vbcrlf
HTML = HTML & " <H1>" & SDB.Localize("Recommended changes to capitalization:") & "</H1>" & vbcrlf
HTML = HTML & " <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">" & vbcrlf
HTML = HTML & " <tr class=""aleft"">" & vbcrlf
HTML = HTML & " <th>" & SDB.Localize("Artist") & "</th>" & vbcrlf
HTML = HTML & " <th>" & SDB.Localize("Title") & "</th>" & vbcrlf
HTML = HTML & " <th>" & SDB.Localize("Album") & "</th>" & vbcrlf
HTML = HTML & " <th>" & SDB.Localize("Album Artist") & "</th>" & VbCrLf
HTML = HTML & " <th>" & SDB.Localize("Filename") & "</th>" & VbCrLf
HTML = HTML & " </tr>" & vbcrlf
Dim i, itm
Dim artist, album, title, albumArtist, FileName
for i=0 to trackList.count-1
HTML = HTML & " <tr" & Style() & ">" & vbcrlf
Set itm = trackList.Item(i)
artist = updateCase(itm.artistName)
title = updateCase(itm.title)
album = updateCase(itm.albumName)
albumArtist = updateCase(itm.albumArtistName)
FileName = updateCase(Mid(itm.path,(InStrRev(itm.path,"\")+1)))
HTML = HTML & outField(artist, itm.artistName)
HTML = HTML & outField(title, itm.title)
HTML = HTML & outField(album, itm.albumName)
HTML = HTML & outField(albumArtist, itm.albumArtistName)
HTML = HTML & outField(FileName, Mid(itm.path,(InStrRev(itm.path,"\")+1)))
If artist <> "" And artist <> itm.artistName Then
holdArtist.add itm, artist
End If
If albumArtist <> "" And albumArtist <> itm.albumArtistName Then
holdAlbumArtist.add itm, albumArtist
End If
If title <> "" And title <> itm.title Then
holdTitle.add itm, title
End If
If album <> "" And album <> itm.albumName Then
holdAlbum.add itm, album
End If
If FileName <> "" And FileName <> Mid(itm.path,(InStrRev(itm.path,"\")+1)) Then
holdFileName.add itm, FileName
End If
HTML = HTML & " </tr>" & vbcrlf
next 'i
HTML = HTML & " </table>" & vbcrlf
HTML = HTML & " </body>" & vbcrlf
HTML = HTML & "</html>" & vbcrlf
WB.SetHTMLDocument( HTML)
SDB.Objects("holdArtist") = holdArtist
SDB.Objects("holdAlbumArtist") = holdAlbumArtist
SDB.Objects("holdAlbum") = holdAlbum
SDB.Objects("holdTitle") = holdTitle
SDB.Objects("holdFileName") = holdFileName
End Sub
