I've been messing around with the code...i got something to show up. But then, I either get a white screen or syntax error. Can someone help me?
[code]
' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'
' "TitleCase.vbs", March-22-2004, v1.0
' VBScript for MediaMonkey 2.3.1 (or above), written by Risser (Edited by me)
'
' Purpose:
' - To update case on 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.
' - Only tested with MP3s
' - Although this script should be safe, USE AT YOUR OWN RISK
'
' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
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'|o'|'o'|of|or|por|the|to|un|une|und|with|y"
Dim forceCapString
forceCapString = "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|AC/|ASCII|ASCIII|ATV|BTO|ELO|ELP|EMI" & _
"|FYC|INXS|MacArthur|OMC|OMD|OMPS|PSI|PTA|REM|REO|Sgt|UB40|UK|USA|USMC|UTFO|" & _
"silence]|T's"
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¼½¾À-ËÎ-ÖØ-ßà-öø-ÿ]" 'if I've missed any, put them here.
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À-ÆÈ-ËÎÏÒ-ÖØ-Ýà-æè-ïò-öø-ýÿ]"
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*(0th|1st|2nd|3rd|[4-9]th|[0-9]['`]?s)$" 'also handles years, like 1950s
Dim littleWordList
littleWordList = Split(littleWordString,"|")
Dim forceCapList
forceCapList = Split(forceCapString,"|")
Public holdAlbum, holdTitle
Set holdAlbum = CreateObject("Scripting.Dictionary")
Set holdTitle = 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) <> "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 holdTitle = nothing
SDB.Objects("CaseThingy") = Nothing
SDB.Objects("holdAlbum") = Nothing
SDB.Objects("holdTitle") = Nothing
End Sub
Sub OnCancel(Btn)
CloseDown
End Sub
Sub OnOK(Btn)
Set holdAlbum = SDB.Objects("holdAlbum")
Set holdTitle = SDB.Objects("holdTitle")
Dim itm, str, sql
Dim items, albumNames, artistNames
Set items = CreateObject("Scripting.Dictionary")
Set albumNames = CreateObject("Scripting.Dictionary")
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 items
If itm.ID>-1 Then
itm.UpdateDB
End If
itm.WriteTags
Next 'itm
Set items = nothing
CloseDown
End Sub
Function MapXML(original)
Dim hold
hold = Replace(original, "&", "&")
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 outField (fixed, normal)
If fixed = normal Then
outField = "<td>" & MapXML(normal) & "</td>" & vbcrlf
Else
outField = "<td class=""highlight"">" & MapXML(fixed) & "</td>" & vbcrlf
End If
End Function
Sub TitleCase
Dim UI, Form, Foot, Btn, Btn2, WB, doc
Dim trackList
Dim writeChanges
Set trackList = SDB.SelectedSongList
If trackList.count=0 Then
Set trackList = SDB.AllVisibleSongList
End If
If trackList.count=0 Then
res = SDB.MessageBox("Select tracks to be updated", mtError, Array(mbOk))
Exit Sub
End If
Set UI = SDB.UI
' Create the window to be shown
Set Form = UI.NewForm
Form.Common.SetRect 50, 50, 500, 400
Form.Common.MinWidth = 200
Form.Common.MinHeight = 150
Form.FormPosition = mmFormScreenCenter
Form.SavePositionName = "CaseWindow"
Form.Caption = SDB.Localize("Changes to Case")
Form.StayOnTop = True
' 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 closes the window
Set Btn = UI.NewButton(Foot)
Btn.Caption = SDB.Localize("&Cancel")
Btn.Common.SetRect (Foot.Common.Width - 180)/2+95, 9, 85, 24
' Btn.Common.SetRect Foot.Common.Width - 90, 9, 85, 24
'Btn.Common.Hint = SDB.Localize("Close this report")
Btn.Common.Anchors = mmAnchorRight + mmAnchorBottom
Btn.UseScript = Script.ScriptPath
Btn.OnClickFunc = "OnCancel"
' Create a button that saves the report
Set Btn2 = UI.NewButton(Foot)
Btn2.Caption = SDB.Localize("&OK")
' Btn2.Common.SetRect Foot.Common.Width - 90 - 5 - btn.common.width - 5, 9, 85, 24
Btn2.Common.SetRect (Foot.Common.Width - 180)/2, 9, 85, 24
'Btn2.Common.Hint = SDB.Localize("Save this report")
Btn2.Common.Anchors = mmAnchorRight + mmAnchorBottom
Btn2.UseScript = Script.ScriptPath
Btn2.OnClickFunc = "OnOK"
' Create a web browser component
Set WB = UI.NewActiveX(Form, "Shell.Explorer")
WB.Common.Align = mmAlignClient ' Fill all client rectangle
WB.Common.ControlName = "WB"
WB.Interf.Navigate "about:" ' A trick to make sure document exists
Set doc = WB.Interf.Document
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
doc.write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & vbcrlf
doc.write "<html>" & vbcrlf
doc.write " <head>" & vbcrlf
doc.write " <title>" & SDB.Localize("Changes to Case") & "</title>" & vbcrlf
doc.write " </head>" & vbcrlf
doc.write "<STYLE TYPE=text/css>" & vbcrlf
doc.write "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}" & vbcrlf
doc.write "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-align:left}" & vbcrlf
doc.write "P{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000;}" & vbcrlf
doc.write "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
doc.write "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
doc.write "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
doc.write "TR.dark{background-color:#EEEEEE}" & vbcrlf
doc.write "TR.aleft TH{text-align:left}" & vbcrlf
doc.write "</STYLE>" & vbcrlf
doc.write " <body>" & vbcrlf
doc.write " <H1>" & SDB.Localize("Changes to Case:") & "</H1>" & vbcrlf
doc.write " <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">" & vbcrlf
' doc.write " <tr><th colspan=""4"">" & SDB.Localize(title) & "</th></tr>" & vbcrlf
doc.write " <tr class=""aleft"">" & vbcrlf
doc.write " <th>" & SDB.Localize("Title") & "</th>" & vbcrlf
doc.write " <th>" & SDB.Localize("Album") & "</th>" & vbcrlf
doc.write " </tr>" & vbcrlf
Dim i, itm
Dim album, title
for i=0 to trackList.count-1
doc.write " <tr" & Style() & ">" & vbcrlf
Set itm = trackList.Item(i)
title = updateCase(itm.title)
album = updateCase(itm.albumName)
doc.write outField(title, itm.title)
doc.write outField(album, itm.albumName)
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
doc.write " </tr>" & vbcrlf
next 'i
doc.write " </table>" & vbcrlf
doc.write " </body>" & vbcrlf
doc.write "</html>" & vbcrlf
doc.close
SDB.Objects("holdAlbum") = holdAlbum
SDB.Objects("holdTitle") = holdTitle
End Sub
[/code]
