Discography Report 2.1 - Updated 17/02/2011

Download and get help for different MediaMonkey for Windows 4 Addons.

Moderators: Peke, Gurus

trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Discography Report 2.1 - Updated 17/02/2011

Post by trixmoto »

This report is similar to the "Other Albums" panel on the MonkeyRok script, but works in batch. It queries Last.Fm and builds a list of all the albums by the artists you have selected, which you do not already have.

The installer can be downloaded from my website. :)

Code: Select all

'
' MediaMonkey Script
'
' NAME: DiscographyReport 2.1
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 17/02/2011
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini 
'          Don't forget to remove comments (') and set the order appropriately
'
' [DiscographyReport]
' FileName=DiscographyReport.vbs
' ProcName=DiscographyReport
' Order=50
' DisplayName=&Discography Report
' Description=Lists missing albums of selected artists
' Language=VBScript
' ScriptType=1
'
' FIXES: Fixed Last.fm not handling errors correctly 
'        Added better artist name fuzzy matching 
' 

Option Explicit
Dim AppTitle : AppTitle = "Discography Report 2.1"
Dim MaxAlbums : MaxAlbums = 0   'o=unlimited
Dim ImageSize : ImageSize = 65  'pixels
Dim ImageMode : ImageMode = 0 	'0=large 1=medium 2=small
Dim ExtraInfo : ExtraInfo = False
Dim TheSource : TheSource = 0   '0=lastfm 1=discogs 
Dim Debug : Debug = False

Sub DiscographyReport
  'check not already running
  Dim list : Set list = SDB.Objects("DiscographyReportList")
  If Not (list Is Nothing) Then
    Exit Sub
  End If
  
  'get selected tracks
  Set list = SDB.SelectedSongList 
  If list.Count = 0 Then 
    Set list = SDB.AllVisibleSongList 
    If list.Count = 0 Then
      Call SDB.MessageBox("DiscographyReport: There are no selected tracks to process.",mtError,Array(mbOk))
      Exit Sub
    End If        
  End If  
  
  'get selected artists
  Dim data : Set data = CreateObject("Scripting.Dictionary")  
  Dim i : i = 0
  For i = 0 To list.Count-1
    Dim itm : Set itm = list.Item(i)
    Dim a : a = Split(itm.ArtistName,";")
    Dim j : j = 0
    For j = 0 To UBound(a)
      data.Item(Trim(a(j))) = ""
    Next
  Next  
  Set SDB.Objects("DiscographyReportItem") = list.Item(0)
  Set list = SDB.NewSongList
  If data.Count > 1 Then
    Call SortData(data)
  End If
  Dim tot : tot = data.Count
  Set SDB.Objects("DiscographyReportList") = list
  Set SDB.Objects("DiscographyReportData") = data
  
  'set progress bar
  Dim prog : Set prog = SDB.Progress
  prog.Text = "DiscographyReport: Initialising script..."
  prog.Value = 0
  prog.MaxValue = tot
  SDB.ProcessMessages
  Set SDB.Objects("DiscographyReportProgress") = prog
  
  'create debug logfile
  If Debug Then 
    Call clear()
    Call out(AppTitle)
    Call out("Artists="&tot)
  End If      
  
  'get options
  Dim ini : Set ini = SDB.IniFile
  If Not (ini.StringValue("DiscographyReport","MaxAlbums") = "") Then
    MaxAlbums = ini.IntValue("DiscographyReport","MaxAlbums")
  End If
  If Not (ini.StringValue("DiscographyReport","ImageSize") = "") Then
    ImageSize = ini.IntValue("DiscographyReport","ImageSize")
  End If
  If Not (ini.StringValue("DiscographyReport","ImageMode") = "") Then
    ImageMode = ini.IntValue("DiscographyReport","ImageMode")
  End If
  If Not (ini.StringValue("DiscographyReport","ExtraInfo") = "") Then
    ExtraInfo = ini.BoolValue("DiscographyReport","ExtraInfo")
  End If
  If Not (ini.StringValue("DiscographyReport","TheSource") = "") Then
    TheSource = ini.IntValue("DiscographyReport","TheSource")
  End If      
  
  'create confirmation
  Dim Form : Set Form = SDB.UI.NewForm 
  Form.Common.SetRect 100, 100, 300, 230
  Form.BorderStyle  = 3
  Form.FormPosition = 4
  Form.SavePositionName = "DiscographyReportPos"
  Form.Caption = AppTitle
  
  Dim Label : Set Label = SDB.UI.NewLabel(Form) 
  Label.Caption = "Create report of albums for "&tot&" selected artists..."
  Label.Common.Left = 10
  Label.Common.Top = 10
  
  Dim Label5 : Set Label5 = SDB.UI.NewLabel(Form) 
  Label5.Caption = "Album data source:"
  Label5.Common.Left = 10
  Label5.Common.Top = 35
  
  Dim EdtSrc : Set EdtSrc = SDB.UI.NewDropdown(Form)
  EdtSrc.Common.Left = 150
  EdtSrc.Common.Top = 32
  EdtSrc.AddItem("Last.fm")
  EdtSrc.AddItem("Discogs.com")
  EdtSrc.Style = 2
  EdtSrc.ItemIndex = TheSource  
  
  Dim Label2 : Set Label2 = SDB.UI.NewLabel(Form) 
  Label2.Caption = "Maximum albums per artist:"
  Label2.Common.Left = 10
  Label2.Common.Top = 60
  
  Dim EdtMax : Set EdtMax = SDB.UI.NewSpinEdit(Form)
  EdtMax.Common.Left = 150
  EdtMax.Common.Top = 57
  EdtMax.Common.Hint = "0 = Unlimited"
  EdtMax.MinValue = 0
  EdtMax.MaxValue = 999
  EdtMax.Value = MaxAlbums  

  Dim Label3 : Set Label3 = SDB.UI.NewLabel(Form) 
  Label3.Caption = "Image size (pixels):"
  Label3.Common.Left = 10
  Label3.Common.Top = 85
  
  Dim EdtSiz : Set EdtSiz = SDB.UI.NewSpinEdit(Form)
  EdtSiz.Common.Left = 150
  EdtSiz.Common.Top = 82
  EdtSiz.MinValue = 10
  EdtSiz.MaxValue = 999
  EdtSiz.Value = ImageSize
  
  Dim Label4 : Set Label4 = SDB.UI.NewLabel(Form) 
  Label4.Caption = "Image source:"
  Label4.Common.Left = 10
  Label4.Common.Top = 110
  
  Dim EdtMod : Set EdtMod = SDB.UI.NewDropdown(Form)
  EdtMod.Common.Left = 150
  EdtMod.Common.Top = 107
  EdtMod.AddItem("Large")
  EdtMod.AddItem("Medium")
  EdtMod.AddItem("Small")
  EdtMod.Style = 2
  EdtMod.ItemIndex = ImageMode

  Dim EdtExt : Set EdtExt = SDB.UI.NewCheckbox(Form)
  EdtExt.Common.Left = 10
  EdtExt.Common.Top = 135
  EdtExt.Common.Width = 250
  EdtExt.Caption = "Display extra album information?"  
  EdtExt.Checked = ExtraInfo
  
  Dim BtnCancel : Set BtnCancel = SDB.UI.NewButton(Form)
  BtnCancel.Caption = "&Cancel"
  BtnCancel.Cancel = True
  BtnCancel.ModalResult = 2
  BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width -25
  BtnCancel.Common.Top = EdtExt.Common.Top + EdtExt.Common.Height +5 
 
  Dim BtnOk : Set BtnOk = SDB.UI.NewButton(Form)
  BtnOk.Caption = "&Ok"
  BtnOk.Default = True
  BtnOk.ModalResult = 1
  BtnOk.Common.Left = BtnCancel.Common.Left - BtnOk.Common.Width -10
  BtnOk.Common.Top = BtnCancel.Common.Top   
  
  'show confirmation screen
  If Not (Form.ShowModal = 1) Then 
    Set SDB.Objects("DiscographyReportList") = Nothing
    Set SDB.Objects("DiscographyReportProgress") = Nothing
    Set SDB.Objects("DiscographyReportData") = Nothing
    Exit Sub
  End If  
  
  'save settings
  MaxAlbums = EdtMax.Value
  ini.IntValue("DiscographyReport","MaxAlbums") = MaxAlbums
  ImageSize = EdtSiz.Value
  ini.IntValue("DiscographyReport","ImageSize") = ImageSize
  ImageMode = EdtMod.ItemIndex
  ini.IntValue("DiscographyReport","ImageMode") = ImageMode
  ExtraInfo = EdtExt.Checked
  ini.BoolValue("DiscographyReport","ExtraInfo") = ExtraInfo
  TheSource = EdtSrc.ItemIndex
  ini.IntValue("DiscographyReport","TheSource") = TheSource
  
  'update debug logfile
  If Debug Then 
    Call out("MaxAlbums="&MaxAlbums)
    Call out("ImageSize="&ImageSize)
    Call out("ImageMode="&ImageMode)
    Call out("ExtraInfo="&ExtraInfo)
    Call out("TheSource="&TheSource)
  End If    
  
  'create queue
  Dim que : Set que = CreateObject("Scripting.Dictionary")
  que.Item("beg") = Timer
  que.Item("lst") = Timer-1
  que.Item("sts") = "READY"
  que.Item("cur") = 0
  que.Item("max") = tot
  If ExtraInfo Then
    que.Item("nxt") = 0
  End If
  Set SDB.Objects("DiscographyReportQueue") = que  
  
  'set controller
  Dim tmr : Set tmr = SDB.CreateTimer(250)
  Set SDB.Objects("DiscographyReportTimer1") = tmr
  Call Script.RegisterEvent(tmr,"OnTimer","Controller") 
End Sub

Sub Controller(tmr) 
  'get progress
  Dim prog : Set prog = SDB.Objects("DiscographyReportProgress")
  If prog Is Nothing Then
    Call ClearUp("Sorry, the progress bar has been lost.",mtError)
    Exit Sub
  End If  
  
  'check cancelled
  If prog.Terminate Then
    Call ClearUp("Process cancelled by user.",mtInformation)
    Exit Sub
  End If  
  
  'get queue
  Dim que : Set que = SDB.Objects("DiscographyReportQueue")
  If que Is Nothing Then
    Call ClearUp("Sorry, the queue has been lost.",mtError)
    Exit Sub
  End If
  
  'check status
  Select Case que.Item("sts") 
    Case "READY"
      'continue
    Case "DONE"
      'continue
    Case "BUSY"
      'check xml
      Dim xml2 : Set xml2 = SDB.Objects("DiscographyReportXML")
      If xml2 Is Nothing Then
        Call ClearUp("Sorry, the xml object has been lost.",mtError)
        Exit Sub
      End If  
      'check item
      Dim itm2 : Set itm2 = SDB.Objects("DiscographyReportItem")
      If itm2 Is Nothing Then
        Call ClearUp("Sorry, the item has been lost.",mtError)
      End If 
      Exit Sub
    Case "EXIT"
      Call ClearUp("Process cancelled by user.",mtInformation)
      Exit Sub      
    Case Else
      Call ClearUp("Sorry, unknown status '"&que.Item("sts")&"'.",mtError)
      Exit Sub
  End Select
  
  'check items left
  ExtraInfo = SDB.IniFile.BoolValue("DiscographyReport","ExtraInfo")
  Dim cur : cur = Int(que.Item("cur"))
  Dim max : max = Int(que.Item("max"))
  If cur >= max Then
    If (ExtraInfo = False) Or (que.Item("sts") = "DONE") Or (que.Item("nxt") = "0") Then
      Call Script.UnregisterEvents(tmr)
      prog.Value = prog.MaxValue
      prog.Text = "DiscographyReport: Finalising..."  
      Call ShowReport()
      Exit Sub
    End If
  End If  
  
  'check last query time
  If Timer < (que.Item("lst")+1) Then
    Exit Sub
  End If
  
  'check extra info
  If (ExtraInfo) And (cur >= max) Then
    que.Item("sts") = "BUSY"
    que.Item("lst") = Timer  
    
    'first time
    Dim nxt : nxt = Int(que.Item("nxt"))
    If cur = max Then
      prog.MaxValue = max+nxt
      prog.Text = "DiscographyReport: Extra information..."
      prog.Value = max
      SDB.ProcessMessages
      que.Item("cur") = cur+1
      que.Item("tot") = nxt
      nxt = 0
    End If    
   
    'process next
    nxt = nxt + 1
    que.Item("nxt") = nxt
    Dim arr : arr = Split(que.Item("~"&nxt),":|:")
    prog.Text = "DiscographyReport: Processing album '"&arr(1)&"' ("&nxt&"/"&que.Item("tot")&")..."
    prog.Value = max+nxt-1
    SDB.ProcessMessages
    
    'send query
    Dim xml3 : Set xml3 = CreateObject("Microsoft.XMLHTTP")
    Dim url3 : url3 = ""
    Select Case TheSource
      Case 0
        url3 = "http://ws.audioscrobbler.com/2.0/?method=album.getInfo&artist="&fixurl(arr(0))&"&album="&fixurl(arr(1))&"&api_key=6cfe51c9bf7e77d6449e63ac0db2ac24"
      Case 1
        url3 = "http://www.discogs.com/release/"&fixurl(arr(3))&"?f=xml&api_key=8dc0e2d488"
    End Select
    If Debug Then 
      Call out("@"&url3)
    End If 
    Call xml3.open("GET",url3,true)
    Call xml3.Send()
    Set SDB.Objects("DiscographyReportXML") = xml3
    Dim res2 : Set res2 = SDB.CreateTimer(100)
    Set SDB.Objects("DiscographyReportTimer2") = res2
    Call Script.RegisterEvent(res2,"OnTimer","Response2") 
    Exit Sub
  End If
  
  'update queue
  cur = cur + 1
  que.Item("sts") = "BUSY"
  que.Item("lst") = Timer
  que.Item("cur") = cur
  
  'check list 
  Dim list : Set list = SDB.Objects("DiscographyReportList")
  If list Is Nothing Then
    Call ClearUp("Sorry, the list has been lost.",mtError)
    Exit Sub
  End If
  
  'check item
  Dim itm : Set itm = Nothing
  Dim data : Set data = SDB.Objects("DiscographyReportData")
  Dim a : a = data.Keys
  Dim nam : nam = a(cur-1)
  
  'update progress
  prog.Text = "DiscographyReport: Processing artist '"&nam&"' ("&cur&"/"&max&")..."
  prog.Value = cur-1
  SDB.ProcessMessages
  
  'send query to last.fm
  Dim str : str = ""
  Select Case TheSource
    Case 0
      str = "http://ws.audioscrobbler.com/2.0/?method=artist.getTopAlbums&artist="&fixurl(nam)&"&api_key=6cfe51c9bf7e77d6449e63ac0db2ac24"
    Case 1 
      str = "http://www.discogs.com/artist/"&fixurl(nam)&"?f=xml&api_key=8dc0e2d488"
  End Select
  If Debug Then 
    Call out("@"&str)
  End If  
  Dim xml : Set xml = CreateObject("Microsoft.XMLHTTP")
  Call xml.open("GET",str,true)
  Call xml.Send()
  Set SDB.Objects("DiscographyReportXML") = xml
  
  'wait for response
  Dim res : Set res = SDB.CreateTimer(100)
  Set SDB.Objects("DiscographyReportTimer2") = res
  Call Script.RegisterEvent(res,"OnTimer","Response")   
End Sub

Sub Response(tmr)  
  'get query
  Dim xml : Set xml = SDB.Objects("DiscographyReportXML")
  If xml Is Nothing Then
    Call Script.UnregisterEvents(tmr)
    Exit Sub
  End If

  'check status  
  If Not (xml.readyState = 4) Then
    Exit Sub
  End If
  Call Script.UnregisterEvents(tmr)
  
  'load xml
  Dim str : str = xml.responseText
  Dim tag : tag = ""
  Select Case TheSource      
    Case 0
      Set xml = LoadLastFmXML(str)
      tag = "album"
    Case 1
      Set xml = LoadDiscogsXML(str)
      tag = "release"
    Case Else
      Set xml = Nothing
  End Select  
  
  'get queue
  Dim que : Set que = SDB.Objects("DiscographyReportQueue")
  If que Is Nothing Then
    Exit Sub
  End If
  
  'get item
  Dim itm : Set itm = Nothing
  Dim data : Set data = SDB.Objects("DiscographyReportData")
  Dim a : a = data.Keys
  Dim cur : cur = Int(que.Item("cur"))
  Dim nam : nam = a(cur-1)
  
  'get item ID
  Dim itmID : itmID = 0
  Dim sql : sql = "SELECT Id FROM Artists WHERE Artist='"&fixsqlart(nam)&"'"
  If Debug Then 
    Call out("#"&sql)
  End If  
  Dim iter : Set iter = SDB.Database.OpenSQL(sql)
  If Not (iter.EOF) Then
    itmID = iter.ValueByIndex(0)
  End If
  Set iter = Nothing
  
  If xml Is Nothing Then
    que.Item("#"&itmID) = ""
    que.Item("sts") = "READY"  
    Exit Sub
  End If     
  
  'get options
  Dim ini : Set ini = SDB.IniFile
  MaxAlbums = ini.IntValue("DiscographyReport","MaxAlbums")
  ImageSize = ini.IntValue("DiscographyReport","ImageSize")  
  ImageMode = ini.IntValue("DiscographyReport","ImageMode")
  ExtraInfo = ini.BoolValue("DiscographyReport","ExtraInfo")

  'get results
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Dim ele,alb,img,elc,art,nxt,upa,rel
  str = ""
  cur = 0
  For Each ele in xml.getElementsByTagName(tag)
    alb = ele.ChildNodes.Item(0).Text
    upa = StripName(alb)
    If Not (dic.Exists(upa)) Then
      dic.Item(upa) = ""
      upa = fixsqlalb(alb) 
      sql = "SELECT Count(*) FROM Albums,ArtistsAlbums WHERE ArtistsAlbums.IDArtist="&itmID 
      sql = sql&" AND ArtistsAlbums.IDAlbum=Albums.ID AND (Albums.Album LIKE '"&upa&"')"
      If Debug Then 
        Call out("#"&sql)
      End If      
      If SDB.Database.OpenSQL(sql).ValueByIndex(0) = 0 Then
        upa = Replace(upa,"Albums.Album","Songs.Album")
        sql = "SELECT Count(*) FROM Songs,ArtistsSongs WHERE ArtistsSongs.IDArtist="&itmID
        sql = sql&" AND ArtistsSongs.IDSong=Songs.ID AND (Songs.Album LIKE '"&upa&"')"
        If Debug Then 
          Call out("#"&sql)
        End If      
        If SDB.Database.OpenSQL(sql).ValueByIndex(0) = 0 Then      
          img = ""
          Select Case TheSource
            Case 0
              art = ele.ChildNodes.Item(3).Text
              img = ele.getElementsByTagName("image").Item(2-ImageMode).Text
              rel = ""
            Case 1
              art = ""
              img = "*@@*"
              rel = ele.getAttribute("id")
          End Select
          If img = "" Then
            img = "http://trixmoto.net/files/none.jpg"
          End If  
          str = str&"<table style='padding-top:8px;' cellpadding='3' cellspacing='0'><tr>"
          str = str&"<td width='40px'>&nbsp;</td><td style='margin:0;padding:0;padding-right:10px;vertical-align:top;'>"
          str = str&"<img style='border:1px solid black;' src='"&img&"' width='"&ImageSize&"' height='"&ImageSize&"'/></td>"
          str = str&"<td align='left' valign='top'><span style='font-size:1.1em;font-weight:bold;'>"
          str = str&alb&"</span><br/><div>"
          If Not (art = "") Then
            str = str&"<a href="""&art&""" target=""_blank"">"&SDB.Localize("More information")&"</a>"
          End If
          If ExtraInfo Then
            If art = "" Then
              art = nam
            Else
              art = Left(art,InStrRev(art,"/")-1)
              art = Mid(art,InStrRev(art,"/")+1)
              art = Replace(art,"+"," ")
            End If
            nxt = Int(que.Item("nxt"))+1
            str = Replace(str,"*@@*","*@"&nxt&"@*",1,1)&"</div><div>**"&nxt&"**</div></td></tr></table>"
            que.Item("~"&nxt) = art&":|:"&alb&":|:"&itmID&":|:"&rel
            que.Item("nxt") = nxt
          Else
            str = str&"</div></td></tr></table>"
          End If
          cur = cur + 1
          If cur = MaxAlbums Then 
            Exit For
          End If
        End If
      End If
      Set iter = Nothing
    End If
  Next 
  
  'finished 
  que.Item("#"&itmID) = str
  que.Item("sts") = "READY"
End Sub

Sub Response2(tmr)  
  'get query
  Dim xml : Set xml = SDB.Objects("DiscographyReportXML")
  If xml Is Nothing Then
    Call Script.UnregisterEvents(tmr)
    Exit Sub
  End If

  'check status  
  If Not (xml.readyState = 4) Then
    Exit Sub
  End If
  Call Script.UnregisterEvents(tmr)  

  'load xml
  Dim str : str = xml.responseText    
  Select Case TheSource      
    Case 0
      Set xml = LoadLastFmXML(str)
    Case 1
      Set xml = LoadDiscogsXML(str)
    Case Else
      Set xml = Nothing
  End Select       
  
  'get queue
  Dim que : Set que = SDB.Objects("DiscographyReportQueue")
  If que Is Nothing Then
    Exit Sub
  End If
  
  'get item
  Dim nxt : nxt = Int(que.Item("nxt"))
  Dim arr : arr = Split(que.Item("~"&nxt),":|:")
  
  'check results  
  If xml Is Nothing Then
    Call que.Remove("~"&nxt)
    que.Item("#"&arr(2)) = Replace(que.Item("#"&arr(2)),"**"&nxt&"**","",1,1)
    If que.Item("nxt") = que.Item("tot") Then
      que.Item("sts") = "DONE" 
    Else
      que.Item("sts") = "READY"
    End If
    Exit Sub
  End If  
  
  'get results
  Dim ele,rel,cur,inf,gen,sty,img
  Select Case TheSource
    Case 0
      For Each ele In xml.getElementsByTagName("releasedate")  
        rel = ele.Text
        If InStrRev(rel,",") > 0 Then
          rel = Left(rel,InStrRev(rel,",")-1)
        End If
      Next    
    Case 1
      For Each ele In xml.getElementsByTagName("released")  
        rel = Replace(ele.Text,"-00-00","")
      Next
      For Each ele In xml.getElementsByTagName("genre")
        If gen = "" Then
          gen = ele.Text
        Else
          gen = gen&", "&ele.Text
        End If
      Next
      For Each ele In xml.getElementsByTagName("style")
        If sty = "" Then
          sty = ele.Text
        Else
          sty = sty&", "&ele.Text
        End If
      Next            
      For Each ele In xml.getElementsByTagName("image") 
        img = ele.getAttribute("uri")
        If Not (img = "") Then
          Exit For
        End If
      Next
      If img = "" Then
        img = "http://trixmoto.net/files/none.jpg"
      End If                        
  End Select    
  For Each ele in xml.getElementsByTagName("track")  
    cur = cur+1
  Next
  If Not (gen = "") Then
    inf = "Genre: "&gen&"<br>"
  End If
  If Not (sty = "") Then
    inf = "Style: "&sty&"<br>"
  End If            
  If Not (rel = "") Then
    inf = "Released: "&rel&"<br>"
  End If
  inf = inf&"Tracks: "&Int(cur)
  
  'finished
  Call que.Remove("~"&nxt)
  que.Item("#"&arr(2)) = Replace(que.Item("#"&arr(2)),"**"&nxt&"**",inf,1,1)
  If Not (img = "") Then
    que.Item("#"&arr(2)) = Replace(que.Item("#"&arr(2)),"*@"&nxt&"@*",img,1,1)
  End If
  If que.Item("nxt") = que.Item("tot") Then
    que.Item("sts") = "DONE" 
  Else
    que.Item("sts") = "READY"
  End If
End Sub

Sub ClearUp(mes,typ)
  Dim tmr : Set tmr = SDB.Objects("DiscographyReportTimer1")
  If Not (tmr Is Nothing) Then
    Call Script.UnregisterEvents(tmr)
    Set SDB.Objects("DiscographyReportTimer1") = Nothing
  End If 
  Set tmr = SDB.Objects("DiscographyReportTimer2")
  If Not (tmr Is Nothing) Then
    Call Script.UnregisterEvents(tmr)
    Set SDB.Objects("DiscographyReportTimer2") = Nothing
  End If    
  Set SDB.Objects("DiscographyReportQueue") = Nothing
  Set SDB.Objects("DiscographyReportProgress") = Nothing
  Set SDB.Objects("DiscographyReportList") = Nothing
  Set SDB.Objects("DiscographyReportItem") = Nothing
  Set SDB.Objects("DiscographyReportData") = Nothing
  Set SDB.Objects("DiscographyReportXML") = Nothing
  If Not (mes = "") Then
    Call SDB.MessageBox("DiscographyReport: "&mes,typ,Array(mbOk))
  End If
End Sub

Function fixurl(sRawURL)
  Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\/:"
  Dim url : url = Replace(sRawURL,"+","%2B")
  If UCase(Right(url,6)) = " (THE)" Then
    url = "The "&Left(url,Len(url)-6)
  End If
  If UCase(Right(url,5)) = ", THE" Then
    url = "The "&Left(url,Len(url)-5)
  End If  
  
  If Len(url) > 0 Then
    Dim i : i = 1
    Do While i < Len(url)+1
      Dim s : s = Mid(url,i,1)
      If InStr(1,sValidChars,s,0) = 0 Then
        Dim d : d = AscW(s)
        If d < 0 Then
          d = d+65536
        End If      
        If d = 32 Or d > 65535 Then
          s = "+"
        Else
          If d < 128 Then
            s = DecToHex(d)
          ElseIf d < 2048 Then
            s = DecToUtf2(d)
          Else
            s = DecToUtf3(d)
          End If
        End If
      Else
        Select Case s
          Case "&"
            s = "%2526"
          Case "/"
            s = "%252F"
          Case "\"
            s = "%5C"
          Case ":"
            s = "%3A"
        End Select
      End If
      fixurl = fixurl&s
      i = i+1
    Loop
  End If
End Function

Function HexToDec(h)
  HexToDec = 0
  Dim i : i = 0
  For i = Len(h) To 1 Step -1
    Dim d : d = Mid(h,i,1)
    d = Instr("0123456789ABCDEF",UCase(d))-1
    If d >= 0 Then
      HexToDec = HexToDec+(d*(16^(Len(h)-i)))
    Else
      HexToDec = 0
      Exit For
    End If
  Next
End Function

Function DecToBin(intDec,e)
  DecToBin = ""
  Dim d : d = intDec
  While e >= 1
    If d >= e Then
      d = d - e
      DecToBin = DecToBin&"1"
    Else
      DecToBin = DecToBin&"0"
    End If
    e = e / 2
  Wend
End Function

Function BinToHex(strBin)
  Dim d : d = 0
  Dim i : i = 0
  For i = Len(strBin) To 1 Step -1
    Select Case Mid(strBin,i,1)
      Case "0"
        'do nothing
      Case "1"
        d = d + (2^(Len(strBin)-i))
      Case Else
        BinToHex = "00"
        Exit Function
    End Select
  Next
  BinToHex = DecToHex(d)
End Function

Function DecToHex(d)
  If d < 16 Then
    DecToHex = "%0"&CStr(Hex(d))
  Else
    DecToHex = "%"&CStr(Hex(d))
  End If
End Function

Function DecToUtf2(d)
  Dim b : b = DecToBin(d,1024)
  Dim a : a = "110"&Left(b,5)
  b = "10"&Mid(b,6)
  DecToUtf2 = BinToHex(a)&BinToHex(b)
End Function 

Function DecToUtf3(d)
  Dim b : b = DecToBin(d,32768)
  Dim a : a = "1110"&Left(b,4)
  Dim c : c = "10"&Mid(b,11,6)
  b = "10"&Mid(b,5,6)
  DecToUtf3 = BinToHex(a)&BinToHex(b)&BinToHex(c)
End Function 

Function DecToUtf4(d)
  Dim b : b = DecToBin(d,557056)
  Dim a : a = "11110"&Left(b,3)
  Dim c : c = "10"&Mid(b,10,6)
  Dim e : e = "10"&Mid(b,16,6)
  b = "10"&Mid(b,4,6)
  DecToUtf4 = BinToHex(a)&BinToHex(b)&BinToHex(c)&BinToHex(e)
End Function 

Sub ShowReport()
  'get queue
  Dim que : Set que = SDB.Objects("DiscographyReportQueue")
  If que Is Nothing Then
    Call ClearUp("Sorry, the queue has been lost.",mtError)
    Exit Sub
  End If  
  
  'get list 
  Dim list : Set list = SDB.Objects("DiscographyReportData")
  Dim a : a = list.Keys
  Dim i : i = 0
  
  'build report
  Dim rep : Set rep = SDB.Tools.FileSystem.CreateTextFile(Script.ScriptPath&".htm",True)
  rep.WriteLine "<html><head><title>"&AppTitle&"</title><style type=text/css>" 
  rep.WriteLine "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}" 
  rep.WriteLine "H1{font-family:'Verdana',sans-serif; font-size:11pt; font-weight:bold; color:#000000; text-align:left}"
  rep.WriteLine "TD{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000;}"          
  rep.WriteLine "</style></head><body><h1>"&Left(AppTitle,InStrRev(AppTitle," ")-1)&"</h1>"
  For i = 0 To list.Count-1
    Dim itmID : itmID = 0
    Dim nam : nam = a(i)
    Dim sql : sql = "SELECT Id FROM Artists WHERE Artist='"&fixsqlart(nam)&"'"
    If Debug Then 
      Call out("#"&sql)
    End If    
    Dim iter : Set iter = SDB.Database.OpenSQL(sql)
    If Not (iter.EOF) Then
      itmID = iter.ValueByIndex(0)
    End If    
    Set iter = Nothing
    rep.WriteLine "<u>"&MapXML(nam)&"</u>"
    rep.WriteLine "  "&que.Item("#"&itmID)&"<br>"
  Next
  rep.WriteLine "</body></html>"
  rep.Close
  
  'show report
  Call ClearUp("",mtInformation)
  If SDB.MessageBox("DiscographyReport: Report complete, display now?",mtConfirmation,Array(mbYes,mbNo)) = mrYes Then
    Dim wsh : Set wsh = CreateObject("WScript.Shell")
    Call wsh.Run(Chr(34)&Script.ScriptPath&".htm"&Chr(34),1,0)
  End If
End Sub

Function MapXML(original) 
   Dim hold : hold = original 
   hold = Replace(hold,"&","&") 
   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

Sub Install()
  Dim inip : inip = SDB.ApplicationPath&"Scripts\Scripts.ini"
  Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
  If Not (inif Is Nothing) Then
    inif.StringValue("DiscographyReport","Filename") = "DiscographyReport.vbs"
    inif.StringValue("DiscographyReport","Procname") = "DiscographyReport"
    inif.StringValue("DiscographyReport","Order") = "50"
    inif.StringValue("DiscographyReport","DisplayName") = "Discography Report"
    inif.StringValue("DiscographyReport","Description") = "Lists missing albums of selected artists"
    inif.StringValue("DiscographyReport","Language") = "VBScript"
    inif.StringValue("DiscographyReport","ScriptType") = "1"
    SDB.RefreshScriptItems
  End If
End Sub

Sub SortData(data)
  Dim i : i = 0
  Dim a : a = data.Keys
  Call SortArray(a)
  Call data.RemoveAll
  For i = 0 To UBound(a)
    data.Item(a(i)) = ""
  Next
End Sub
  
Sub SortArray(arr)
  Call QuickSort(arr,LBound(arr),UBound(arr))
End Sub

Sub QuickSort(vec,loBound,hiBound)
  Dim pivot,loSwap,hiSwap,temp

  If hiBound - loBound = 1 Then
    If Vec(loBound) > Vec(hiBound) Then
      temp = Vec(loBound)
      Vec(loBound) = Vec(hiBound)
      Vec(hiBound) = temp
    End If
  End If

  pivot = Vec(Int((loBound + hiBound) / 2))
  Vec(Int((loBound + hiBound) / 2)) = Vec(loBound)
  Vec(loBound) = pivot
  loSwap = loBound + 1
  hiSwap = hiBound
  
  Do
    While loSwap < hiSwap And Vec(loSwap) <= pivot
      loSwap = loSwap + 1
    WEnd
    While Vec(hiSwap) > pivot
      hiSwap = hiSwap - 1
    WEnd
    If loSwap < hiSwap then
      temp = Vec(loSwap)
      Vec(loSwap) = Vec(hiSwap)
      Vec(hiSwap) = temp
    End If
  Loop While loSwap < hiSwap
  
  Vec(loBound) = Vec(hiSwap)
  Vec(hiSwap) = pivot
  
  If loBound < (hiSwap - 1) Then 
    Call QuickSort(vec,loBound,hiSwap-1)
  End If
  If hiSwap + 1 < hibound Then 
    Call QuickSort(vec,hiSwap+1,hiBound)
  End If
End Sub   

Function fixsqlalb(name)
  fixsqlalb = Replace(name,"'","''")
  fixsqlalb = Replace(fixsqlalb,"&","&")
  If Right(fixsqlalb,1) = "!" Then
    fixsqlalb = Left(fixsqlalb,Len(fixsqlalb)-1)&"' OR Albums.Album = '"&fixsqlalb
  Else
    If Right(fixsqlalb,1) = "?" Then
      fixsqlalb = Left(fixsqlalb,Len(fixsqlalb)-1)&"' OR Albums.Album = '"&fixsqlalb  
    Else
      fixsqlalb = fixsqlalb&"' OR Albums.Album LIKE '"&fixsqlalb&"_"
    End If
  End If
  If InStr(fixsqlalb," & ") > 0 Then
    fixsqlalb = Replace(fixsqlalb," & "," And ")&"' OR Albums.Album = '"&Replace(fixsqlalb," & "," + ")&"' OR Albums.Album = '"&fixsqlalb
  Else
    If InStr(fixsqlalb," + ") > 0 Then
      fixsqlalb = Replace(fixsqlalb," + "," And ")&"' OR Albums.Album = '"&Replace(fixsqlalb," + "," & ")&"' OR Albums.Album = '"&fixsqlalb
    Else  
      If InStr(fixsqlalb," And ") > 0 Then
        fixsqlalb = Replace(fixsqlalb," And "," & ")&"' OR Albums.Album = '"&Replace(fixsqlalb," And "," + ")&"' OR Albums.Album = '"&fixsqlalb
      End If
    End If
  End If    
End Function

Function fixsqlart(name)
  fixsqlart = Replace(name,"'","''")
  fixsqlart = Replace(fixsqlart,"&","&")
  If SDB.IniFile.BoolValue("Options","IgnoreTHEs") Then
    Dim str : str = SDB.IniFile.StringValue("Options","IgnoreTHEStrings") 
    If Not (str = "") Then
      Dim thes : thes = Split(str,",")
      Dim i : i = 0
      For i = 0 To UBound(thes)
        Dim s : s = Trim(thes(i))&" "
        If UCase(Left(name,Len(s))) = UCase(s) Then
          fixsqlart = Mid(fixsqlart,Len(s)+1)&"' OR Artist='"&fixsqlart
          Exit For
        End If
      Next
    End If     
  End If
End Function

Sub clear()
  Dim wsh : Set wsh = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")
  If Right(loc,1) = "\" Then
    loc = loc&"DiscographyReport.log"
  Else
    loc = loc&"\DiscographyReport.log"
  End If
  Dim logf : Set logf = fso.CreateTextFile(loc,True)
  logf.Close
End Sub

Sub out(txt)
  Dim wsh : Set wsh = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")
  If Right(loc,1) = "\" Then
    loc = loc&"DiscographyReport.log"
  Else
    loc = loc&"\DiscographyReport.log"
  End If  
  Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
  logf.WriteLine(Time&" "&SDB.ToAscii(txt))
  logf.Close
End Sub

Function LoadLastFmXML(str)
  Set LoadLastFmXML = CreateObject("Microsoft.XMLDOM")
  Call LoadLastFmXML.LoadXML(str)
  If LoadLastFmXML.parseError.errorCode <> 0 Then
    Call out("@ErrorCode="&LoadLastFmXML.parseError.errorCode)
    Call out("@ErrorMess="&LoadLastFmXML.parseError.reason)
    Call out("@ErrorLine="&LoadLastFmXML.parseError.line)
    Call out("@ErrorChar="&LoadLastFmXML.parseError.linepos)
    Call out("@ErrorText="&LoadLastFmXML.parseError.srcText)
    Set LoadLastFmXML = Nothing
  Else
    If InStr(str,"<lfm status=""ok"">") = 0 Then
      Dim lfm : Set lfm = Nothing
      For Each lfm In LoadLastFmXML.getElementsByTagName("lfm")
        Call out("@ErrorStat="&lfm.attributes.getNamedItem("status").nodeValue)
      Next
      For Each lfm In LoadLastFmXML.getElementsByTagName("error")
        Call out("@ErrorCode="&lfm.attributes.getNamedItem("code").nodeValue)
        Call out("@ErrorMess="&lfm.Text)
      Next
      Set LoadLastFmXML = Nothing
    End If                  
  End If  
End Function

Function LoadDiscogsXML(str)
  Set LoadDiscogsXML = CreateObject("Microsoft.XMLDOM")
  Call LoadDiscogsXML.LoadXML(str)
  If LoadDiscogsXML.parseError.errorCode <> 0 Then
    Call out("@ErrorCode="&LoadDiscogsXML.parseError.errorCode)
    Call out("@ErrorMess="&LoadDiscogsXML.parseError.reason)
    Call out("@ErrorLine="&LoadDiscogsXML.parseError.line)
    Call out("@ErrorChar="&LoadDiscogsXML.parseError.linepos)
    Call out("@ErrorText="&LoadDiscogsXML.parseError.srcText)
    Set LoadDiscogsXML = Nothing
  Else
    If InStr(str,"<resp stat=""ok"" version=""1.0"" requests") = 0 Then
      Set LoadDiscogsXML = Nothing
    End If                  
  End If  
End Function

Function StripName(nam)
  StripName = ""
  If nam = "" Then
    Exit Function
  End If
  Dim i : i = 0
  Dim s : s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÅÄÂÃÁÀÆËÊÉÈÏÎÍÌÖÔÕÓÒØÜÛÚÙÝÇÐÑß"
  Dim t : t = UCase(nam)
  t = Replace(t,"&","AND")
  t = Replace(t,"+","AND")
  t = Replace(t," N ","AND")
  t = Replace(t,"'N'","AND")  
  For i = 1 To Len(t)
    Dim c : c = Mid(t,i,1)
    If InStr(s,c) > 0 Then
      StripName = StripName&c
    End If
  Next
End Function
Last edited by trixmoto on Tue May 27, 2008 3:58 am, edited 5 times in total.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Guest

Post by Guest »

But.. How is it used? When I start up MediaMonkey, how do I startup this script?
Bex
Posts: 6316
Joined: Fri May 21, 2004 5:44 am
Location: Sweden

Post by Bex »

It's a report. You find all MM's reports in "File->Create Reports"
Advanced Duplicate Find & Fix Find More From Same - Custom Search. | Transfer PlayStat & Copy-Paste Tags/AlbumArt between any tracks.
Tagging Inconsistencies Do you think you have your tags in order? Think again...
Play History & Stats Node Like having your Last-FM account stored locally, but more advanced.
Case & Leading Zero Fixer Works on filenames too!

All My Scripts
some1
Posts: 91
Joined: Tue Jul 03, 2007 3:10 am

Post by some1 »

Hey!
I like this!
But could I have the artist which I have selected at the top, and then jump to the album?
Could It also compair what albums I have, and say the ones which are missing?

Thanking for this!
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

Thanks for the suggestions, I'll take a look at them soon.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

@some1 - what do you mean by "jump to the album"? The script should only show you albums which are not in your library already.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

New version (1.1) is now available to download from my website. Changes include...

- Added option to specify which image to get from Last.Fm
- Added option to get extra album information from Last.Fm
- Fixed links in non-IE browsers

Not yet MM3 compatible, sorry! :)
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

You know, I don't think I ever tried this script out until a few moments ago. My only gripe would be that it uses Last.FM, could we maybe see some other sources (ones that are more "controlled") in the future? Such as maybe MusicBrainz (AMG would be ideal, but we all know how they feel about taking their information *Rolls Eyes*)

Just a thought, since Last.FM's information can come from anywhere with no real moderation. (at least this is the way I think Last.FM works *shrugs*)
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

Although I understand the quality of data might not be great, that's why they allow such easy and free access to it, and generally speaking I find it pretty good. Sources which spend a lot of time and money making their data really high quality, don't allow people to "steal" it, as they see it.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

Completely understandable. I think the thing that makes LastFM's the most annoying (to me at least) is that you can get the same album several times. Such as "8Mile", "8 Mile", "8 Mile OST", "8 Mile Soundtrack" etc, you know?

Maybe Discogs is something worth looking into as a possible second option though. I ran across this (Discogs API Documentation) while snooping around their page earlier. Looks like it's a way pull their information, I could be wrong.

You might look into it, see what's up, and if I just sent you on a wild goose chase, feel free to tell me so, Lol.
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

Yay me for double post! Ha.

Anyway, ran into an error a moment ago.

Code: Select all

Error #9 - Microsoft VBScript runtime error
Subscript out of range: '[number: 1]'
File: "C:\Program Files\MediaMonkey\Scripts\DiscographyReport.vbs", Line: 165, Column: 4
It appears on such artists as "Kool G Rap & DJ Polo", "Skatterman & Snug Brim", "The Notorious B.I.G.", "Lil' Wayne", "Eazy-E", "(hed) p.e.", "Who Wride", "Critical Bill" and "U$O".

The only link I can see is they all have Non Alpha-Numeric characters or spaces. Though, "Tech N9ne" and "Ghostface Killah" work perfectly fine, even with the space (though "Who Wride" and "Critical Bill" do not). *Shrugs*

Maybe it throws up this error if it does find information for that artist?
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

Well I'm a bit stumped. Basically the script builds a list of albums to go and get extra information for (if you have the variable set to True) and the error is being thrown because an item in the list is blank - I've no idea how this could happen! I'll try to investigate... :)
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Mizery_Made
Posts: 2283
Joined: Tue Aug 29, 2006 1:09 pm
Location: Kansas City, Missouri, United States

Post by Mizery_Made »

Turning off that option stops the error, though on the ones that would give the error, results in an empty report. Strange.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

Could you please email me a track with doesn't work? I might have to create a debug version for you to run if I cannot replicate the errors.
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
trixmoto
Posts: 10024
Joined: Fri Aug 26, 2005 3:28 am
Location: Hull, UK
Contact:

Post by trixmoto »

New version (1.2) is now available to download from my website. Changes include...

- Fixed url encoding of some characters
- Fixed errors when getting extra info if there isn't any

@Mizery_Made - Notorious B.I.G. should get a nice report now! :)
Download my scripts at my own MediaMonkey fansite.
All the code for my website and scripts is safely backed up immediately and for free using Dropbox.
Post Reply