Code: Select all

Sub Pickem
Dim list, itm, i, a, b, artist, album
' Set List
Set list = SDB.AllVisibleSonglist
	If list.count=0 Then
		res = SDB.MessageBox( "View Tracks to be played, please.", mtInformation, Array(mbOk))
		Exit Sub
	End If
Set plr=SDB.Player

plr.PlaylistClear

Dim Progress
Set Progress = SDB.Progress
Progress.Text = "Working..."

'Export to MM all songs
Progress.MaxValue = list.count

artist = InputBox( "Which Artist would you like to hear?")

album = InputBox( "Which Album from this Artist would you like to hear?")

' Fix case for some fields 
    artist = DoCaseFix( artist, False)   ' do artist and album at first as they can cause re-read of data 
    album = DoCaseFix( album, False) 
 
For a=0 to list.count-1
	Set itm=list.item(a)

		If ((itm.ArtistName = artist) and (itm.AlbumName = album)) Then
			plr.PlaylistAddTrack(itm)

			Progress.Value=a+1

			If Progress.Terminate Then
			Exit For
			End If
		End If
Next

If plr.PlaylistCount=0 Then
	res=SDB.MessageBox("Your entry was invalid.", mtInformation, Array(mbOK))
	Exit Sub
End If

For b=0 to list.count-1
	Set itm=list.item(b)
		If itm.Title="End" Then
			plr.PlaylistAddTrack(itm)
		End If
Next
plr.Play

End Sub

' This script fixes case (Uppercase or Lowercase problems) of several fields 

Dim CaseExceptions   ' Exceptions in case conversions 
Set CaseExceptions = CreateObject("Scripting.Dictionary") 

' The first strings are expected to be fully in lowercase 
CaseExceptions.Add "to", "to"    
CaseExceptions.Add "in", "in" 
CaseExceptions.Add "and", "and" 
CaseExceptions.Add "on", "on" 
CaseExceptions.Add "of", "of" 
CaseExceptions.Add "ac", "AC"    ' Handle AC/DC name  ;-) 
CaseExceptions.Add "dc", "DC" 
CaseExceptions.Add "a", "a" 
CaseExceptions.Add "the", "the" 
CaseExceptions.Add "i", "I"       ' handle Greek numbers 
CaseExceptions.Add "ii", "II" 
CaseExceptions.Add "iii", "III" 
CaseExceptions.Add "iv", "IV" 
CaseExceptions.Add "vi", "VI" 
CaseExceptions.Add "vii", "VII" 
CaseExceptions.Add "viii", "VIII" 
CaseExceptions.Add "ix", "IX" 
CaseExceptions.Add "xi", "XI" 
CaseExceptions.Add "xii", "XII" 
CaseExceptions.Add "xiii", "XIII" 
CaseExceptions.Add "xiv", "XIV" 
CaseExceptions.Add "xv", "XV"     ' up to 15 should be enough... 
CaseExceptions.Add "n", "n"       ' handle "Rock n Roll" 


Function DoCaseFix( src, UpperCaseOnlyFirst) 
  Dim result, pos, srclen, startpos, ch, word, first, rest, i, forcelower 

  src = LCase( src) 
  pos = 1 
  srclen = Len( src) 
  first = True 
  forcelower = False 

  Do While pos<=srclen 
    startpos = pos 
    Do While pos<=srclen 
      ch = Asc( Mid( Src, pos, 1)) 
      If (ch<97) Or ((ch>122) and (ch<129)) Then 
        Exit Do 
      End If 
      pos = pos + 1 
    Loop 

    If pos>startpos Then 
      ' We found a word, check if it isn't an exception and process it accordinly 
      word = Mid( src, startpos, pos-startpos) 
      If CaseExceptions.Exists(word) Then 
        word = CaseExceptions( word) 
        If first Then 
          result = result + UCase( Left( word, 1)) + Mid( word, 2) 
        Else 
          result = result + word 
        End If 
      Else 
        If UpperCaseOnlyFirst And Not first Then 
          ' All characters go to lower-case, except for the first one 
          result = result + word 
        Else 
          ' Put the first letter to upper-case 
          If forcelower then 
            result = result + word 
          Else 
            result = result + UCase( Left( word, 1)) + Mid( word, 2) 
          End If 
        End If 
      End If 
    End If 

    first = False 
    forcelower = False 

    startpos = pos 
    Do While pos<=srclen 
      ch = Asc( Mid( Src, pos, 1)) 
      If Not((ch<97) Or ((ch>122) and (ch<129))) Then 
        Exit Do 
      End If 
      pos = pos + 1 
    Loop 

    ' simply copy all other characters 
    rest = Mid( src, startpos, pos-startpos) 
    i = Len( rest) 
    If i>0 Then 
      ch = Asc( Right( rest, 1)) 
      If ch=46 Then  ' '.' causes the next letter to be uppercased 
        first = True 
      End If 
      If (ch=39) or (ch=96) Then 
        forcelower=True 
      End If 
    End If 
    result = result + rest 
  Loop 

  DoCaseFix = result 
End Function 

Code: Select all

'rdNormalizeArtistAlbumTitles (version 1)

'- Standardizes case for Artist, Album, and Titles
  'Forces initial caps for most words
  'Forces all caps for words with all consonants.  (Y is considered a vowel.)
  'Replaces backwards tic with forwards tic
  'Allows for exceptions to those rules
'- Moves any initial preposition to the end of a field for Artist, Album, and Titles
  'examples:
    ' "The Ancient"  --> "Ancient, The"
    ' "The Ancient (mono)" --> "Ancient, The (mono)"

'written by Roylayer, 3/16/2004 
'requires that these public procedures be added to "MediaMonkey init.vbs" or to this script:
'  rdArrayPos, rdBuildBracketExpr, rdCharListException, rdInsertStr, rdLeftParenPos, rdQS, rdReplaceStr
'  source location:  http://www.songs-db.com/forum/viewtopic.php?t=1523
'feel free to use "as is" or borrow and modify code.  user assumes all risks.

Option Explicit

'------------------------------------------------------------------------------------

Sub rdNormalizeArtistAlbumTitles
  ' Define variables 
  Dim list, Itm, i, Temp, sql, Progress, LastArtist, NewArtistName, NewAlbumName, NewTitle, FieldsChanged
  Dim CaseExceptions   ' Exceptions to case conversions.  created in rdInitCaseExceptions
  Dim Preps()  'list of prepositions.  allocated in rdInitPres

  call rdInitPreps(Preps)
  call rdInitCaseExceptions(CaseExceptions)

  FieldsChanged = false

  ' Get list of selected tracks from MediaMonkey 
  Set list = SDB.SelectedSongList 
  If list.count=0 Then 
    Set list = SDB.AllVisibleSongList 
  End If 

  'Set up progress 
  Set Progress = SDB.Progress 
  Progress.Text = "Fixing case of words and moving initial prepositions..." 
  Progress.MaxValue = list.count 

  ' Process all selected tracks 
  For i=0 To list.count-1 
    Set Itm = list.Item(i) 

    if Itm.ArtistName <> LastArtist then
      LastArtist = Itm.ArtistName
      'only do when artist name changes.  
      'this is done for efficiency only, assuming that the list will be sorted by artist name.
      'script will still work if that is not true

      NewArtistName = rdFixCase(Itm.ArtistName, "", CaseExceptions, Preps)
      NewArtistName = rdMoveInitPrep(NewArtistName, Preps)

      if NewArtistName <> Itm.ArtistName then
        'must use sql because Itm.UpdateDB does not update the album artist field
        'note: this has the side effect of changing the artist for all songs - not just those that were selected
        sql = "UPDATE Artists SET Artists.Artist = " & rdQS(NewArtistName) & " WHERE Artists.Artist= " & rdQS(Itm.ArtistName)
        SDB.database.execSQL(sql)
      end if
    end if

    NewAlbumName = rdFixCase(Itm.AlbumName, "", CaseExceptions, Preps)
    NewAlbumName = rdMoveInitPrep(NewAlbumName, Preps)

    NewTitle = rdFixCase(Itm.Title, "", CaseExceptions, Preps)
    NewTitle = rdMoveInitPrep(NewTitle, Preps)

    ' Update the changes in DB 
    if NewArtistName <> Itm.ArtistName or NewAlbumName <> Itm.AlbumName or NewTitle <> Itm.Title then
      FieldsChanged = true
      Itm.ArtistName = NewArtistName  'artist name already changed in database.  this just helps the display.

      'note: this has the side effect of changing the album for all songs - not just those that were selected
      Itm.AlbumName = NewAlbumName

      Itm.Title = NewTitle
      Itm.UpdateDB 
    end if

    Progress.value = i + 1 
    If Progress.terminate Then 
       Exit For  'allows user to right click progress bar to stop script
    End if    
  Next 

  set List = nothing
  set Itm = nothing
  set Progress = nothing
  set CaseExceptions = nothing

  if FieldsChanged = true then
    msgbox "Be sure to synchronize tags"  'you may wish to remove this line
  end if
End Sub  'rdNormalizeArtistAlbumTitles

'------------------------------------------------------------------------------------

Function rdFixCase(InString, Delims, CaseExceptions, Preps)
  'Forces initial caps for most words
  'Forces all caps if there is only 1 word with all consonants.  (Y is considered a vowel.)
  'Replaces backwards tic with forwards tic
  'Allows for exceptions to those rules

  Dim RegEx, SubMatch, Match, Matches, i, j, RetStr, BracketEXpr, Result, Parsed
  dim MatchPos, MatchIndx, Word

  Result = lcase(InString)  'force everything to lower case.  will make selected chars uper case later.
  Result = replace(Result, "`", "'")  'replace backwards tic with forwards tic

  if Result = "the the" then
    'special case for the band "The The".  Both The's need to be capitalized!  ;-)
    '(future enhancement:  another CaseExceptions object to match the entire InString)
    rdFixCase = "The The"
    exit function
  end if

  if Delims = "" then
    'use default
    'DON'T INCLUDE:
    '  '  used in contractions and possessive forms

    'INCLUDE:
    '  -  good for compound words and two words separated by a dash.  
    '       this is good for capitalization purposes.  Not good for a small number of other cases.
    '  (  the start of a word almost always follows.
    '  _  especially good for cases where _ is used instead of a space to separate words
    '  +  the start of a word almost always follows.
    '  |  the start of a word almost always follows.
    '  ,  the start of a word almost always follows.
    '  .  start of word follows if part of ellipses (...)
    '       good for acronymns like U.K.
    '  /  usually a separator between two words
    '*****the other characters aren't likely to be used in the middle of words.  assume a new word follows.

    BracketExpr = " ~!@#$%^&*()_+\-={}|[\]\\:"";<>?,./"
  else
    BracketExpr = rdBuildBracketExpr(Delims)
  end if

  'PARSE WORDS USING REGEX:

  'word = group of 1 or more non-delim chars
  'non-word = group of 1 or more delim chars
  'pattern = 1 word + 0 or 1 non-words

  Set RegEx = New RegExp
  RegEx.Pattern = "([^" & BracketExpr & "]+)[" & BracketExpr & "]*"  'will produce 1 submatch for the word within each match
  RegEx.Global = true  'allows multiple word/non-word pairs to be matched in the string
  Set Matches = RegEx.Execute(Result)

  'LOGIC FOR EACH MATCH:
  'strip 's from word to handle possessive form of words
  'if exception then
  '  if always use (*) then translate
  '  elseif leave alone (-) then restore case from original string
  '  else  
  '    if first word then init caps
  '    elseif prep found 
  '      if prep found at end or before paren expr then init caps
  '      else translate
  '    else translate
  'elseif all consonants then cap all
  'else init caps

  MatchIndx = 0
  For Each Match in Matches   ' Iterate Matches collection.
    MatchIndx = MatchIndx + 1
    MatchPos = Match.FirstIndex + 1  'FirstIndex is zero-based
    Word = Match.SubMatches(0)

    if right(Word, 2) = "'s" then
      'handle possessive form of words
      Word = left(Word, len(Word) - 2)
    end if

    If CaseExceptions.Exists(Word) Then 
      Parsed = split(CaseExceptions(Word), " ")
      if ubound(Parsed, 1) = 1 then
        'always use exception "as is".  (assume 2nd part of exception is "*".)
        Result = rdReplaceStr(Result, MatchPos, len(Word), Parsed(0))
      elseif ubound(Parsed, 1) = 0 and Parsed(0) = "-" then
        'leave word alone.  replace with original word from InString
        Result = rdReplaceStr(Result, MatchPos, len(Word), mid(InString, MatchPos, len(Word)))
      else
        'use exception only if first word or preposition logic doesn't apply
        if MatchIndx = 1 then
          'if first word then init caps
          Result = rdReplaceStr(Result, MatchPos, 1, ucase(mid(Result, MatchPos, 1)))
        elseif rdArrayPos(Preps, Word) >= 0 then
          'preposition found (not in first word).  see if it should be treated like first word or not.
          regEx.Pattern = "^, " & Word & "(?: +[([].*[)\]])?$"
          if regEx.Test(mid(Result, MatchPos - 2)) = true then
            'preposition found in last word or before parenthetical expression.  ignore exception and capitalize word
            Result = rdReplaceStr(Result, MatchPos, 1, ucase(mid(Result, MatchPos, 1)))
          else
            'preposition should not be treated like first word.  use exception.
            'Note:  preps after -, (, . etc. should probably be capitalized but aren't
            '       example:  Up Up and Away:  the Definitive Collection
            Result = rdReplaceStr(Result, MatchPos, len(Word), Parsed(0))
          end if  
        else
          'not first word and not a preposition.  use exception
          Result = rdReplaceStr(Result, MatchPos, len(Word), Parsed(0))
        end if
      end if
    elseif rdCharListException(Word, "bcdfghjklmnpqrstvwxz") = 0 then
      'all consonants.  ("y" is considered a vowel.)  assume acronym.  force all chars to upper case
      Result = rdReplaceStr(Result, MatchPos, len(Word), ucase(Word))
    else
      'not all consonants.  upper case first letter
      Result = rdReplaceStr(Result, MatchPos, 1, ucase(mid(Result, MatchPos, 1)))
    end if
  Next

  set RegEx = nothing
  set Match = nothing
  set Matches = nothing

  rdFixCase = Result
End Function  'rdFixCase

'------------------------------------------------------------------------------------

Function rdMoveInitPrep(InString, Preps)
  Dim result, Parsed, Pos, StartPos, LPP

  result = trim(InString)  'strip leading or trailing spaces
  Parsed = split(result, " ", 2)

  if ubound(Parsed, 1) < 1 then
    'no words or one word found.  nothing to do.
    rdMoveInitPrep = result
    exit function
  end if

  if rdArrayPos(Preps, lcase(Parsed(0))) = -1 then
    'preposition not found
    rdMoveInitPrep = result
    exit function
  end if

  if lcase(result) = "the the" then
    'special case for the band "The The".  DON'T move first word!  ;-)
    rdMoveInitPrep = result
    exit function
  end if

  LPP = rdLeftParenPos(Parsed(1), len(Parsed(1)))

  if LPP = 0 then
    'no parenthetical expression found or mismatched parens
    rdMoveInitPrep = rdMovePrepToEnd(Parsed(0),Parsed(1))
    exit function
  elseif LPP = 1 then
    'case like "the (xxx)".  treat as normal case without parenthetical expression
    rdMoveInitPrep = rdMovePrepToEnd(Parsed(0),Parsed(1))
    exit function
  else
    'case like "The Ancient (mono)".  Move prep before parenthetical expression
    StartPos = LPP - 1

    'find first non-blank char before left paren
    for Pos = StartPos to 1 step -1
      if mid(Parsed(1), Pos, 1) <> " " then
        'insert prep before parenthetical expression
        rdMoveInitPrep = rdInsertStr(Parsed(1), pos + 1, ", " & Parsed(0))
        exit function
      end if
    next

    msgbox "logic error in rdMoveInitPrep.  InString= " & vbcrlf & InString
    rdMoveInitPrep = InString
  end if
End Function  'rdMoveInitPrep

'------------------------------------------------------------------------------------

Function rdMovePrepToEnd(Prep, Part2)
  rdMovePrepToEnd = Part2 & ", " & Prep
End function  'rdMovePrepToEnd

'------------------------------------------------------------------------------------

Sub rdInitPreps(Preps)
  redim preps(8)  'must be changed if any preps added to list below

  'all preps in this array must be lower case
  Preps(0) = "a"
  Preps(1) = "an"
  Preps(2) = "the"
  Preps(3) = "el"
  Preps(4) = "los"
  Preps(5) = "la"
  Preps(6) = "las"
  Preps(7) = "il"
  Preps(8) = "le"
  'Preps(9) = "les"  'can't use "les" because it is also a first name
End sub  'rdInitPreps

'------------------------------------------------------------------------------------

sub rdInitCaseExceptions(CaseExceptions)
  'thanks go to Jiri for his original design of CaseExceptions from his FixCase.vbs script
  '(http://www.songs-db.com/forum/viewtopic.php?t=949)

  Set CaseExceptions = CreateObject("Scripting.Dictionary") 

  'the first string is expected to be fully in lowercase 
  'the second string can have these formats:
    'ReplString    -->  replace with this string unless first word or preposition logic takes precedence
    'ReplString *  -->  always replace with this string
    '-             -->  do not ever change case for this string

  CaseExceptions.Add "abba", "ABBA *" 
  CaseExceptions.Add "abc", "ABC *" 
  CaseExceptions.Add "abwh", "ABWH *" 
  CaseExceptions.Add "ac", "AC *"    ' Handle AC/DC name  ;-) 
  CaseExceptions.Add "aka", "AKA *" 
  CaseExceptions.Add "brdcst", "brdcst *" 
  CaseExceptions.Add "bto", "BTO *" 
  CaseExceptions.Add "dr", "Dr *" 
  CaseExceptions.Add "echolyn", "echolyn *" 
  CaseExceptions.Add "ep", "-"
  CaseExceptions.Add "elo", "ELO *"
  CaseExceptions.Add "elp", "ELP *"
  CaseExceptions.Add "inc", "inc"  'inc = incomplete.  no need to capitalize
  CaseExceptions.Add "iq", "IQ *" 
  CaseExceptions.Add "izz", "IZZ *" 
  CaseExceptions.Add "jr", "Jr *" 
  CaseExceptions.Add "mr", "Mr *" 
  CaseExceptions.Add "mrs", "Mrs *" 
  CaseExceptions.Add "ms", "Ms *" 
  CaseExceptions.Add "nebelnest", "NeBeLNeST *" 
  CaseExceptions.Add "nyc", "NYC *" 
  CaseExceptions.Add "pt", "pt" 
  CaseExceptions.Add "sd", "sd" 
  CaseExceptions.Add "sr", "Sr *" 
  CaseExceptions.Add "st", "St *" 
  CaseExceptions.Add "sgt", "Sgt *" 
  CaseExceptions.Add "trk", "trk" 
  CaseExceptions.Add "ufo", "UFO *" 
  CaseExceptions.Add "vsop", "VSOP *" 
  CaseExceptions.Add "xyz", "XYZ *" 
  CaseExceptions.Add "xr40", "XR40 *" 

  CaseExceptions.Add "i", "I *"       ' handle Roman numbers 
  CaseExceptions.Add "ii", "II *" 
  CaseExceptions.Add "iii", "III *" 
  CaseExceptions.Add "iv", "IV *" 
  CaseExceptions.Add "vi", "VI *" 
  CaseExceptions.Add "vii", "VII *" 
  CaseExceptions.Add "viii", "VIII *" 
  CaseExceptions.Add "ix", "IX *" 
  CaseExceptions.Add "xi", "XI *" 
  CaseExceptions.Add "xii", "XII *" 
  CaseExceptions.Add "xiii", "XIII *" 
  CaseExceptions.Add "xiv", "XIV *"  'up to 14 should be enough... 

'  May also want to do these:  
'  CaseExceptions.Add "a", "a"
'  CaseExceptions.Add "and", "and" 
'  CaseExceptions.Add "in", "in" 
'  CaseExceptions.Add "of", "of" 
'  CaseExceptions.Add "the", "the"
'  CaseExceptions.Add "to", "to"    
'  CaseExceptions.Add "n", "n"       ' handle "Rock n Roll" 
'  CaseExceptions.Add "w", "w"   'handles abbreviation for with - w/____
End sub  'rdInitCaseExceptions