TitleCase.vbs

Download and get help for different MediaMonkey Addons.

Moderators: Peke, Gurus

BriAstlym13
Posts: 4
Joined: Sun Feb 11, 2018 1:31 am

Re: TitleCase.vbs

Post by BriAstlym13 » Sun Feb 11, 2018 12:31 pm

I'm not sure if there was a topic like this before. Also, I'm not sure where I should post this.


How can I modify the capitalization script to just capitalize the song title and album? I do not need the artist nor album artist. Thank you. :)

Peke
Posts: 11338
Joined: Tue Jun 10, 2003 7:21 pm
Location: Serbia
Contact:

Re: TitleCase.vbs

Post by Peke » Sun Feb 11, 2018 4:42 pm

Hi,
You can find Case.vbs Script under MMW installation\Scripts folder and that is the one you need to edit.

HINT: I would suggest that you rename file and add corresponding scripts.ini entry in order to avoid overwrite on MMW update.

As for edit I would suggest that you use http://www.mediamonkey.com/wiki/index.php/Scripting
Best regards,
Pavle
MediaMonkey Team lead QA/Tech Support guru
Admin of Free MediaMonkey addon Site HappyMonkeying
Image
Image
How to add Images to forum

BriAstlym13
Posts: 4
Joined: Sun Feb 11, 2018 1:31 am

Re: TitleCase.vbs

Post by BriAstlym13 » Sun Feb 11, 2018 7:17 pm

Thank you. I can try and mess around with a copy and see what works. I am not knowledgeable about coding. All I can do is mess around and hope I get something.

BriAstlym13
Posts: 4
Joined: Sun Feb 11, 2018 1:31 am

Re: TitleCase.vbs

Post by BriAstlym13 » Mon Feb 12, 2018 11:31 am

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: Select all

' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'
'                "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, "  ", "&nbsp; ")
   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

Stigg
Posts: 232
Joined: Wed May 18, 2011 7:56 pm

Re: TitleCase.vbs

Post by Stigg » Mon Feb 12, 2018 11:28 pm

I don't mess around with little words and big words. I capitalize every word.
It looks great for titles and artists.

BriAstlym13
Posts: 4
Joined: Sun Feb 11, 2018 1:31 am

Re: TitleCase.vbs

Post by BriAstlym13 » Tue Feb 13, 2018 1:09 pm

So, do you mean...*Take Me To The River* Instead of Take Me to the River?

Stigg
Posts: 232
Joined: Wed May 18, 2011 7:56 pm

Re: TitleCase.vbs

Post by Stigg » Tue Feb 13, 2018 8:57 pm

BriAstlym13 wrote:So, do you mean...*Take Me To The River* Instead of Take Me to the River?
Yes. It's called Proper Case.

Post Reply