Lyric Timer 3.0 [MM2]

[Teknojnky]

Thats pretty nifty, but I get the following error when I try to run it..

[Guest]

Trix,

I've just installed version 2 (having previously reported problems with prior version), and it's working a dream. Thank you.

The dockable panel also functions excellently. Thought I'd mention it, because I think this script is one of the first (that I've installed) which uses this. I understand it's a recent addition by the Developers.

I've now installed the Inline Lyrics script and tested with a newly timed set of Lyrics. It's brilliant.

One thought I had. Is it possible to hide the time brackets in the Lyrics tag?

Will continue to test out when more time available.

Thanks again.

[trixmoto]

@Teknojnky - This is a security issue, the script is being blocked from connecting to MM.

@Guest - "hide the time time brackets in the Lyrics tag" - I don't understand. You mean from the display panel? Or from the tag in the track? Or are you talking about Inline Lyrics?

[Guest]

Sorry I wasn't clear.

Right click properties of song; Lyrics tab. When viewing the Lyrics there, the time for each line is displayed before each line. Rather than just the Lyrics text. It strikes me that other scripts eg Detailed Song Info Panel which can display the Lyrics would also show this. Cosmetic thing.

[trixmoto]

So where would you like the time tags to be stored? They need to be stored somewhere.

[Guest]

It's not a problem. It's fine as it is.

Thanks.

[Guest]

Trix,

The fixes on Inline lyrics have done wonders for the Lyric Timer. Thanks.

But I'm still getting the Com Server warning due to the Com object still running (despite closing). Trouble is, sometimes, but not always, this causes MM to lock up even though I've already closed it. The desktop freezes. It's no big deal, as I just close MM (Not responding) from the Task Manager to return control.

Even so, MM isn't always closing properly because of the (still) active Com object.

Is this one for the Developers?

NB I'm now running RC3.

[trixmoto]

No, I am currently fixing this problem. It's because the second script is still trying to access MM whilst MM's trying to close. This should be fixed in the next version.

[trixmoto]

New version (2.1) has been condensed into a single, more stable script file.

Code: Select all

'
' MediaMonkey Script
'
' NAME: LyricTimer 2.1
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 20/03/2006
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini
'          Don't forget to remove comments (') and set the order appropriately
'
' FIXES: Combine with helper to create single script file
'
' [LyricTimer]
' FileName=LyricTimer.vbs
' ProcName=LyricTimer
' Order=17
' DisplayName=Lyric Timer
' Description=Add timings to lyrics
' Language=VBScript
' ScriptType=0
'

Option Explicit
Public styleOn
Dim Tmr,Data
Dim classname,curr,trax,isong
Dim OddColour, EvenColour, TextColour, HighlightColour

OddColour = "#FFFFFF"      'white
EvenColour = "#EFEFEF"      'silver
TextColour = "#000000"      'black
HighlightColour = "#FFFF77"   'yellow

Sub LyricTimer
  Dim Form
  Set Form = SDB.Objects("LyricTimer")
  If Form is Nothing Then
    Set Form = SDB.UI.NewDockablePersistentPanel("LyricPanel")
    If Form.IsNew Then
      Form.DockedTo = 2
      Form.Common.Width = 250
    End If
    Form.Caption = "Lyric Timer"
 
    Dim Head
    Set Head = SDB.UI.NewPanel(Form)
    Head.Common.Align = 1
    Head.Common.Height = 25
   
    Dim Btn1
    Set Btn1 = SDB.UI.NewButton(Head)
    Btn1.Caption = "Revert back"
    Btn1.Common.Height = 25
    Btn1.Common.Width = 100
    Btn1.Common.Left = 0
    Btn1.UseScript = Script.ScriptPath
    Btn1.OnClickFunc = "BackClick"
 
    Dim Btn2
    Set Btn2 = SDB.UI.NewButton(Head)
    Btn2.Caption = "Save changes"
    Btn2.Common.Height = 25
    Btn2.Common.Width = 100
    Btn2.Common.Left = 100
    Btn2.UseScript = Script.ScriptPath
    Btn2.OnClickFunc = "SaveClick"
 
    Dim Btn3
    Set Btn3 = SDB.UI.NewButton(Head)
    Btn3.Caption = "Loop: No"
    Btn3.Common.ControlName = "Btn3"
    Btn3.Common.Height = 25
    Btn3.Common.Width = 100
    Btn3.Common.Left = 200
    Btn3.UseScript = Script.ScriptPath
    Btn3.OnClickFunc = "LoopClick"

    Dim WB
    Set WB = SDB.UI.NewActiveX(Form, "Shell.Explorer")
    WB.Common.Align = 5
    WB.Common.ControlName = "WB"
    If SDB.VersionHi=2 and SDB.VersionLo<5 Then WB.Interf.Navigate "about:"
    SDB.Objects("LyricDoc") = WB.Interf.Document
  Else
    If Form.Common.Visible Then
      Form.Common.Visible = False
      Exit Sub
    End If
  End If

  Form.Common.Visible = True
  SDB.Objects("LyricTimer") = Form
  SDB.Objects("LyricData") = Nothing
 
  Set Tmr = SDB.CreateTimer(100)
  Script.RegisterEvent Tmr, "OnTimer", "Update"
End Sub

Sub Update(Timer)
  'update track list
  Dim song
  Set song = SDB.Player.CurrentSong
  If song is Nothing Then
    If classname = "" Then
      classname = "nosong"
      curr = 0
      trax = 0
      writedocument()
      Set Data = CreateObject("Scripting.Dictionary")
    End If
  Else
    If not song.ID = isong Then
      classname = ""
      curr = 0     
      isong = song.ID
      trax = extractlyrics()
      writedocument()
      SDB.Objects("LyricData") = Data
    End If
  End If
 
  'update track highlight
  Dim newcurr,doc
  newcurr = getcurr()
  If newcurr <> curr Then
    Set doc = SDB.Objects("LyricDoc")
    If curr > 0 Then
      doc.getElementById("row"&curr).className = classname
    End If
    classname = doc.getElementById("row"&newcurr).className
    doc.getElementById("row"&newcurr).className = "highlight"
    curr = newcurr
  End If
 
  'loop song
  Dim Form,Btn
  Set Form = SDB.Objects("LyricTimer")
  Set Btn = Form.Common.ChildControl("Btn3")
  If Btn.Caption = "Loop: Yes" Then
    If SDB.Player.CurrentSongLength > 0 Then
      If SDB.Player.PlaybackTime > SDB.Player.CurrentSongLength-3500 Then
        SDB.Player.PlaybackTime = 0
      End If
    End If
  End If
 
  'stop when hidden
  If Not Form.Common.Visible Then Script.UnregisterEvents Timer
  Set Btn = Nothing
  Set Form = Nothing
End Sub

Function getcurr()
  Dim indx
  getcurr = 1
  Do While getcurr<100
    indx = Data.Item("time"&(getcurr+1))
    If indx <> "" Then
      If SDB.Player.PlaybackTime > CLng(indx) Then
        getcurr = getcurr + 1
      Else
        Exit Do
      End If
    Else
      Exit Do
    End If
  Loop
End Function

Function settime(lng)
  Dim min,sec,hun,tint
  tint = lng\60000
  If tint < 10 Then
    min = "0"&tint
  Else
    min = ""&tint
  End If
  lng = lng - (tint*60000)
  tint = lng\1000
  If tint < 10 Then
    sec = "0"&tint
  Else
    sec = ""&tint
  End If
  lng = lng - (tint*1000) 
  tint = lng\10
  If tint < 10 Then
    hun = "0"&tint
  Else
    hun = ""&tint
  End If
  lng = lng - (tint*10)
  settime = "["&min&":"&sec&"."&hun&"]"
End Function

Function gettime(txt)
  Dim min,sec,hun,temp
  If Len(txt) = 8 Then
    temp = Mid(txt,1,2)
    If isNumeric(temp) Then min = Clng(temp)
    temp = Mid(txt,4,2)
    If isNumeric(temp) Then sec = Clng(temp)
    temp = Mid(txt,7,2)
    If isNumeric(temp) Then hun = Clng(temp) 
  End If
  gettime = min*60000 + sec*1000 + hun*10
End Function

Function simplify(txt)
  Dim a,b,c,d,l
  a = InStr(txt,"<")
  If a = 0 Then
    simplify = txt
    Exit Function
  End If
  b = InStr(txt,">")
  l = Len(txt)
  c = Mid(txt,1,a-1)
  If b = 0 Then b = a
  d = Mid(txt,b+1,l-b)
  txt = c&d
  a = InStr(txt,"<")
  If a > 0 Then txt = simplify(txt)
  simplify = txt
End Function

Function MapXML(original)
   Dim hold
   hold = Replace(original, "&", "&amp;")
   hold = Replace(hold, "  ", "&nbsp; ")
   hold = Replace(hold, "<", "&lt;")
   hold = Replace(hold, ">", "&gt;")
   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 Style()
  styleOn = Not styleOn
  If styleOn Then
    Style = ""
  Else
    Style = " class='dark'"
  End If
End Function

Function extractlyrics()
  Dim song,lrc,ina,inp,str,pos,cur,txt

  Set Data = CreateObject("Scripting.Dictionary")
  Set song = SDB.Player.CurrentSong
  lrc = song.Lyrics
  trax = 0
 
  If lrc <> "" Then
    ina = split(lrc,VBCrLf)
    inp = 0
 
    If Left(ina(inp),4) = "[ti:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.Title
    End If
    Data.Add "title", str
 
    If Left(ina(inp),4) = "[ar:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.ArtistName
    End If
    Data.Add "artist", str
 
    If Left(ina(inp),4) = "[au:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.Author
    End If
    Data.Add "author", str
 
    If Left(ina(inp),4) = "[al:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = song.AlbumName
    End If
    Data.Add "album", str

    If Left(ina(inp),4) = "[ve:" Then
      str = Mid(ina(inp),5,Len(ina(inp))-5)
      inp = inp + 1
    Else
      str = "1.0"
    End If
    Data.Add "version", str
 
    For pos = inp to UBound(ina)
      trax = pos-inp+1
      If ina(pos) = "" Then
        Data.Add "time"&trax, "0"
        Data.Add "line"&trax, ""
      Else
        If Left(ina(pos),1) = "[" Then
          str = gettime(Mid(ina(pos),2,8))
          Data.Add "time"&trax, str
          str = Mid(ina(pos),11,Len(ina(pos))-10)
          Data.Add "line"&trax, str
        Else
          Data.Add "time"&trax, "0"
          Data.Add "line"&trax, ina(pos)
        End If
      End If
    Next
  End If
  extractlyrics = trax
End Function

Function writedocument()
  Dim doc
  Set doc = SDB.Objects("LyricDoc")
       
  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("Lyric Timer") & "</title>" & vbcrlf
  doc.write "  </head>" & vbcrlf

  doc.write "  <STYLE TYPE=text/css>" & vbcrlf
  doc.write "    body{font-family:'Verdana',sans-serif; background-color:"&OddColour&"; font-size:9pt; color:"&TextColour&";}" & vbcrlf
  doc.write "    P{font-family:'Verdana',sans-serif; font-size:8pt; color:"&TextColour&";}" & vbcrlf
  doc.write "    TH{font-family:'Verdana',sans-serif; font-size:9pt; font-weight:bold; color:"&TextColour&"; border-color:"&TextColour&"; 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:"&TextColour&"; border-color:"&TextColour&"; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf
  doc.write "    TR.highlight{background-color:"&HighlightColour&"}" & vbcrlf
  doc.write "    TR.dark{background-color:"&EvenColour&"}" & vbcrlf
  doc.write "    TR.aleft TH{text-align:left}" & vbcrlf
  doc.write "  </STYLE>" & vbcrlf
       
  doc.write "  <SCRIPT Language='VBScript'>" & vbcrlf
  doc.write "    Dim SDB,Data" & vbcrlf
  doc.write "    Set SDB = CreateObject(""SongsDB.SDBApplication"")" & vbcrlf
  doc.write "    Function gotopos (i)" & vbcrlf
  doc.write "      Set Data = SDB.Objects(""LyricData"")" & vbcrlf
  doc.write "      Data.Item(""time""&i) = SDB.Player.PlaybackTime" & vbcrlf
  doc.write "      document.getElementById(""span""&i).innerHTML = settime(Data.Item(""time""&i))" & vbcrlf
  doc.write "      SDB.Objects(""LyricsData"") = Data" & vbcrlf
  doc.write "    End Function" & vbcrlf
  doc.write "    Function settime(lng)" & vbcrlf
  doc.write "      Dim min,sec,hun,tint" & vbcrlf
  doc.write "      tint = lng\60000" & vbcrlf
  doc.write "      If tint < 10 Then " & vbcrlf
  doc.write "        min = ""0""&tint" & vbcrlf
  doc.write "      Else" & vbcrlf
  doc.write "        min = """"&tint" & vbcrlf
  doc.write "      End If " & vbcrlf
  doc.write "      lng = lng - (tint*60000)" & vbcrlf
  doc.write "      tint = lng\1000" & vbcrlf
  doc.write "      If tint < 10 Then" & vbcrlf
  doc.write "        sec = ""0""&tint" & vbcrlf
  doc.write "      Else" & vbcrlf
  doc.write "        sec = """"&tint" & vbcrlf
  doc.write "      End If" & vbcrlf
  doc.write "      lng = lng - (tint*1000)" & vbcrlf
  doc.write "      tint = lng\10" & vbcrlf
  doc.write "      If tint < 10 Then" & vbcrlf
  doc.write "        hun = ""0""&tint" & vbcrlf
  doc.write "      Else" & vbcrlf
  doc.write "        hun = """"&tint" & vbcrlf
  doc.write "      End If" & vbcrlf
  doc.write "      lng = lng - (tint*10)" & vbcrlf
  doc.write "      settime = ""[""&min&"":""&sec&"".""&hun&""]""" & vbcrlf
  doc.write "    End Function" & vbcrlf
  doc.write "  </SCRIPT>" & vbcrlf

  doc.write "  <body>" & vbcrlf 
  doc.write "    <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">" & vbcrlf 
 
  If trax > 0 Then
    doc.write "      <tr class=""aleft"">" & vbcrlf
    doc.write "        <th></th>" & vbcrlf
    doc.write "        <th>" & SDB.Localize("Timestamp") & "</th>" & vbcrlf
    doc.write "        <th>" & SDB.Localize("Line") & "</th>" & vbcrlf 
    doc.write "      </tr>" & vbcrlf
    Dim i
    For i = 1 To trax
      doc.write "      <tr id='row"&i&"'" & Style() & ">" & vbcrlf
      doc.write "        <td><a href=""vbscript:gotopos("&i&")"">Line "&i&"</a></td>" & vbcrlf
      doc.write "        <td><span id='span"&i&"'>" & MapXML(settime(data.Item("time"&i))) & "</span></td>" & vbcrlf
      doc.write "        <td>" & MapXML(simplify(data.Item("line"&i))) & "</td>" & vbcrlf           
      doc.write "      </tr>" & vbcrlf
    Next 
  Else
    doc.write "      <tr id='row1'" & Style() & ">" & vbcrlf
    doc.write "        <th colspan=3>There are no lyrics available for this song.</th>" & vbcrlf 
    doc.write "      </tr>" & vbcrlf
  End If
 
  doc.write "    </table>" & vbcrlf
  doc.write "  </body>" & vbcrlf
  doc.write "</html>" & vbcrlf
  doc.close
  writedocument = True
End Function

Sub BackClick (ClickedBtn)
  Dim res,str,WShell
  res = SDB.MessageBox("Are you sure you wish to undo your changes?",mtConfirmation,Array(mbOk,MbCancel))
  If res = 1 Then
    isong = -1
  End If
End Sub

Sub SaveClick (ClickedBtn)
  Dim res,str,pos,lng,song
  res = SDB.MessageBox("Are you sure you wish to save your changes?",mtConfirmation,Array(mbOk,mbCancel))
  If res = 1 Then
    str = ""
    pos = 1
 
    If Data.Item("title") <> "" Then
      str = str&"[ti:"&Data.Item("title")&"]"&vbcrlf
    End If   
    If Data.Item("artist") <> "" Then
      str = str&"[ar:"&Data.Item("artist")&"]"&vbcrlf
    End If   
    If Data.Item("author") <> "" Then
      str = str&"[au:"&Data.Item("author")&"]"&vbcrlf
    End If   
    If Data.Item("album") <> "" Then
      str = str&"[al:"&Data.Item("album")&"]"&vbcrlf
    End If
    If Data.Item("version") <> "" Then
      str = str&"[ve:"&Data.Item("version")&"]"&vbcrlf
    End If
   
    Do While Data.Item("time"&pos) <> ""
      lng = Clng(Data.Item("time"&pos))
      If Right(str,2) <> vbcrlf Then str=str&vbcrlf
      str = str&settime(lng)
      str = str&Data.Item("line"&pos)
      pos = pos + 1
    Loop
   
    Set song = SDB.Player.CurrentSong
    song.Lyrics = str
    song.UpdateDB
  End If
End Sub

Sub LoopClick (ClickedBtn)
  If ClickedBtn.Caption = "Loop: Yes" Then
    ClickedBtn.Caption = "Loop: No"
  Else
    ClickedBtn.Caption = "Loop: Yes"
  End If
End Sub

[Guest]

Trixmoto,

LyricTimer 2.1 is throwing up loads of errors and won't run at all. I can't tell you what the errors are because a general error box is covering them up. This error dialogue is blinking and locking everything up, so I have to close MM from Task Manager.

Also - In the Add/Remove properties, MediaMonkey has been replaced by:

MediaMonkey Script - LyricTimer 2.1

...but it's MediaMonkey's uninstall string, not LyricTimer's!

[trixmoto]

Well I don't get the errors so unless you can give me a hint, I've nothing to fix.

The Inno Setup Installer program I use to create the installers for my scripts does change the name of the MediaMonkey uninstall, but that's all. You'll find this will all the installers.

[Guest]

OK. No offence intended.

I'll have another go with it, and see what I can find. I'll get back to you. Thanks.

[Guest]

Update.

I've tried manually adding the script as well as re-running the installer, but I'm still getting the following:

1. A dialogue box which says "Error executing script event"

2. This is covering up a dialogue which is displaying the runtime error. If I ok or attempt to move 1. - it copies itself.

I can make out this much of the runtime error:

Error #424.......................................................Line 131 Column 4

(which I think is an object required problem). The line is:

Code: Select all

    classname = doc.getElementById("row"&newcurr).className

NB The player continues to play, but because the errors are stealing focus, I have to ctrl-alt-del the app.

[trixmoto]

Yes, unfortunately because the timer is set to run every 100ms so you get a good update speed, once an error occurs you get too many message to deal with (10 a second!) - can't find a way to catch these properly.

I will look at this line and see if I can work out the problem.

Cheers for your help

[Orthimnas]

I was having the same problem, where I would get an error dialog with general errors over it.

I got it to work flawlessly by making the following adjustments:
1) In internet explorer, changing my "Internet" security settings to enable "Initialize and script ActiveX controls not marked as safe"
2) Added in a reference to Data in Sub SaveClick - updated code:

Code: Select all

Sub SaveClick (ClickedBtn)
  Dim res,str,pos,lng,song,Data
  res = SDB.MessageBox("Are you sure you wish to save your changes?",mtConfirmation,Array(mbOk,mbCancel))
  Set Data = SDB.Objects("LyricData")
  If res = 1 Then
    str = ""
    pos = 1
 
    If Data.Item("title") <> "" Then
      str = str&"[ti:"&Data.Item("title")&"]"&vbcrlf
    End If   
    If Data.Item("artist") <> "" Then
      str = str&"[ar:"&Data.Item("artist")&"]"&vbcrlf
    End If   
    If Data.Item("author") <> "" Then
      str = str&"[au:"&Data.Item("author")&"]"&vbcrlf
    End If   
    If Data.Item("album") <> "" Then
      str = str&"[al:"&Data.Item("album")&"]"&vbcrlf
    End If
    If Data.Item("version") <> "" Then
      str = str&"[ve:"&Data.Item("version")&"]"&vbcrlf
    End If
   
    Do While Data.Item("time"&pos) <> ""
      lng = Clng(Data.Item("time"&pos))
      If Right(str,2) <> vbcrlf Then str=str&vbcrlf
      str = str&settime(lng)
      str = str&Data.Item("line"&pos)
      pos = pos + 1
    Loop
   
    Set song = SDB.Player.CurrentSong
    song.Lyrics = str
    song.UpdateDB
  End If
  Set Data = Nothing
End Sub

Now it works perfectly - except that little COM error. It doesn't freeze my system, but it does make me click "Yes" to allow closing. It seems to be hinged on the use of Internet Explorer. Even if I close it before I close MM, it gives me the error.

Thanks for a great product!
~ Orthimnas ~