Well I don't know a whole heck-of-a-lot about scripting but I did manage to hack together a version of the script to work with version 2 of the Discogs API. Removed all the code requiring an API Key, borrowed some code from Let's DiscogsAutoWebTagger, and kept some of the changes that Eyal made earlier and posted in this thread...yhsiuqs wrote:
If you know anything about scripting, feel free to take the script and modify it however you feel fit...hopefully we will one day have an integrated solution that is both user-friendly AND bug-free!
I've also cobbled together an installation package which can be downloaded from http://www3.telus.net/sowiakj/EarliestD ... tDate.mmip
The logic is the same as yhsiuqs original script, except that updates to the database are not made automatically (as per Eyals changes), and the results appear to be OK. Results are not quite as good as I would like for songs that are included in hundreds of releases (eg. The Beatles).
For those that wanted an APIv2.0 update, hope it works for you, I've tested on Windows XP and Windows 7 x64.
J.
The Code:
Code: Select all
'This script will display a dockable window that shows the searched release dates from discogs,
'will automatically select and save the earliest exact match to date only
'
'made by yhsiuqs http://www.mediamonkey.com/forum/viewtopic.php?f=2&t=42411
'email to ubersquishy at gmail dot com
'Updated to use Discogs API v2.0 by wxdude April 25, 2012
Public Const iMatchesPerSong = 10
Public XMLdoc, XMLdoc2
Public SrchTxt, SearchURL
Public aSongMatchLinks
'
' the first fields in the last Publicension is an integer showing the heirarchy of the release year
'
' 1 = earliest release year from all results, is an exact match
' 2 = earliest release year from all results, not an exact match
' 3 = earliest release year from exact matches
' 4 = earliest release year from non-exact matches
' 5 = later release, is an exact match
' 6 = later release, is not an exact match
'
Public xData
Public oRelease
Public aTrackList
Public aReleaseLinks()
Public Mnu, Pnl, LblCurrent, lMatches, lCurrent, nMatches
Public rButtons()
Sub OnStartup
Dim x
Set UI = SDB.UI
Set Pnl = UI.NewDockablePersistentPanel("DateFixer")
if Pnl.IsNew then
Pnl.DockedTo = 2
Pnl.Common.Width = 300
end if
Pnl.Caption = "Earliest Date"
redim rButtons(iMatchesPerSong)
Set lCurrent = UI.NewLabel(Pnl)
lCurrent.Autosize = False
lCurrent.Alignment = 2 'centered
lCurrent.Caption = "Current Info"
lCurrent.Common.SetRect 10, 50, Pnl.Common.Width-20, 20
lCurrent.Common.Anchors = 7 'Left+Top+Right 'wxdude: changed from 5/ Eyal: changed from 15 '1+2+4+8
Set LblCurrent = UI.NewLabel(Pnl)
LblCurrent.Autosize = False
LblCurrent.Alignment = 2 'centered
LblCurrent.Common.SetRect 10, 70, Pnl.Common.Width-20, 20
LblCurrent.Common.Anchors = 7 'Left+Top+Right 'wxdude:changed from 5/ Eyal: changed from 15 '1+2+4+8
Set lMatches = UI.NewLabel(Pnl)
lMatches.Autosize = False
lMatches.Alignment = 2 'centered
lMatches.Caption = "Search Results"
lMatches.Common.SetRect 10, 100, Pnl.Common.Width-20, 20
lMatches.Common.Anchors = 7 'Left+Top+Right 'wxdude:changed from 5/ Eyal: changed from 15 '1+2+4+8
for x = 1 to imatchespersong
set rbuttons(x-1) = UI.NewRadioButton(Pnl)
rbuttons(x-1).Common.SetRect 10,120+(x-1)*20,Pnl.Common.Width-20, 20
rbuttons(x-1).Caption = ""
rbuttons(x-1).Checked = False
rbuttons(x-1).Common.Visible = False
rbuttons(x-1).Common.ControlName = cstr("r" & x)
Script.RegisterEvent rbuttons(x-1).common, "OnClick", "EvalButtons"
next
Pnl.Common.Visible = true 'make panel visible
' Add menu item that shows panel after it is closed
Set Mnu = SDB.UI.AddMenuItem(SDB.UI.Menu_View,1,-1)
Mnu.Caption = "Earliest Date"
Mnu.Checked = Pnl.Common.Visible
SDB.Objects("Panel") = Pnl
SDB.Objects("Menu") = Mnu
Script.RegisterEvent Pnl, "OnClose", "PnlClose"
Script.RegisterEvent Mnu, "OnClick", "ShowPanel"
Script.RegisterEvent SDB, "OnPlay", "SearchCurrent"
End Sub
Sub ShowPanel(Item)
Pnl.Common.Visible = not Pnl.Common.Visible
Mnu.Checked = Pnl.Common.Visible
End Sub
Sub PnlClose( Item)
Mnu.Checked = false
End Sub
Sub SearchCurrent
LookupYear
End Sub
Sub LookupYear()
Dim art,track,year,ss,u,v, w, x, y, z
Set UI = SDB.UI
Set XMLdoc = CreateObject("Microsoft.XMLDOM")
XMLdoc.async = "false"
Set XMLdoc2 = CreateObject("Microsoft.XMLDOM")
XMLdoc2.async = "false"
u = 0
Set xdata = SDB.Player.CurrentSong
art = xdata.artistname
track = xdata.title
year = xdata.year
srchtxt = art & " - " & track
for x = 1 to imatchespersong
rbuttons(x-1).Caption = ""
rbuttons(x-1).Checked = False
rbuttons(x-1).Common.Visible = False
next
if cint(year) > 0 then
LblCurrent.Caption = srchtxt & ", " & year
else
LblCurrent.Caption = srchtxt & ", no date"
end if
ss = "artist:" & art & " track:" & track
SearchURL= "http://api.discogs.com/search?q=" & URLEncodeUTF8(CleanSearchString(ss)) & "&type=releases&f=xml"
if XMLdoc.load(SearchURL) then 'there is search results
set asongmatchlinks = xmldoc.getElementsByTagName("uri")
u = 0
if asongmatchlinks.length >= imatchespersong then
u = imatchespersong
elseif asongmatchlinks.length > 0 then
u = asongmatchlinks.length
end if
if u > 0 then
redim areleaselinks(u)
redim atemp(u,4)
for y = 0 to (u - 1) 'load release links into array
areleaselinks(y) = mid(asongmatchlinks(y).childnodes(0).nodevalue, instr(asongmatchlinks(y).childnodes(0).nodevalue ,"/release/")+9)
next
for y = 0 to (u - 1)
if XMLdoc2.load("http://api.discogs.com/release/" & areleaselinks(y) & "?f=xml") then
' if cint(XMLdoc2.selectSingleNode("/resp").attributes.item(2).value) > 5000 then 'maxumimum Discogs searches have been performed for today
' LblCurrent.Caption = "You have reached the maximum allowable searches from Discogs. Please try again in 24 hours."
' exit sub
' end if
set oRelease = XMLdoc2.selectSingleNode("/resp/release")
atemp(y,1) = oRelease.selectSingleNode("artists/artist/name").text 'artist
Set aTrackList = oRelease.selectNodes("tracklist/track")
soriginal = ucase(track)
for each z in aTrackList
slookup = ucase(z.selectsinglenode("title").text)
if slookup = soriginal then 'exact match
atemp(y,2) = z.selectsinglenode("title").text
exit for
elseif instr(1,slookup,soriginal) <> 0 or instr(1,soriginal,slookup) <> 0 then 'title is found in the song title
atemp(y,2) = z.selectsinglenode("title").text
end if
next
if atemp(y,2) <> vbnullstring then 'found a match
on error resume next
z = 0
z = oRelease.selectsinglenode("released").text
if z <> 0 then
atemp(y,3) = left(oRelease.selectsinglenode("released").text,4) 'release year
else
atemp(y,3) = vbnullstring
end if
on error goto 0
if instr(1,ucase(atemp(y,1)),ucase(art)) <> 0 or instr(1,ucase(art),ucase(atemp(y,1))) <> 0 then
if instr(1,ucase(atemp(y,2)),ucase(track)) <> 0 or instr(1,ucase(track),ucase(atemp(y,2))) <> 0 then'matched artist and title
atemp(y,0) = 5 'show it's an exact match
end if
else
atemp(y,0) = 6 'the data is in question
end if
rbuttons(y).Common.Visible = True
if atemp(y,3) <> vbnullstring then
rbuttons(y).Caption = atemp(y,1) & " - " & atemp(y,2) & ", " & atemp(y,3)
else
rbuttons(y).Caption = atemp(y,1) & " - " & atemp(y,2) & ", no date"
end if
end if
end if
next
z = (-1) 'set earliest compare index for exact matches
v = (-1) 'set index for non exact matches
for y = 0 to (u - 1)
if atemp(y,3) <> vbnullstring and isnumeric(atemp(y,3)) then 'there is a year found
if atemp(y,0) = 5 then 'exact match
if z = (-1) then 'haven't found an earlier release year in exact matches
if len(year) > 1 then
if cint(atemp(y,3)) < cint(year) then 'it's earlier than the current date
atemp(y,0) = 3
z = y
end if
else 'no year currently
atemp(y,0) = 3
z = y
end if
elseif cint(atemp(y,3)) < cint(atemp(z,3)) then 'it's an earlier release date
atemp(y,0) = 3
atemp(z,0) = 5
z = y
end if
else 'non exact
if v = (-1) then 'haven't found an earlier release year in non exact matches
if len(year) > 1 then
if cint(atemp(y,3)) < cint(year) then 'it's earlier than the current date
atemp(y,0) = 4
v = y
end if
else
atemp(y,0) = 4
v = y
end if
else
if cint(atemp(y,3)) < cint(atemp(v,3)) then 'it's an earlier release date
atemp(y,0) = 4
atemp(v,0) = 6
v = y
end if
end if
end if
end if
next
if z <> (-1) and v <> (-1) then 'both exact and non exact have dates
if cint(atemp(z,3)) <= cint(atemp(v,3)) then 'exact match is earlier or same release year
pnl.common.childcontrol("r" & z+1).checked = False 'Eyal: changed for False
else 'non exact is earliest
pnl.common.childcontrol("r" & v+1).checked = False 'Eyal: changed for False
end if
else
if z <> (-1) then 'there is an exact match
pnl.common.childcontrol("r" & z+1).checked = False 'Eyal: changed for False
elseif v <> (-1) then 'there is a non exact match, but not an exact match
pnl.common.childcontrol("r" & v+1).checked = False 'Eyal: changed for False
else 'no matches
end if
end if
EvalResults
end if
end if
End Sub
Sub EvalResults
Dim x
for x = 1 to imatchespersong
if rbuttons(x-1).common.visible = true then
if pnl.common.childcontrol("r" & x).checked = true then
if right(rbuttons(x-1).caption,4) <> "date" then 'there is a date
xdata.originalyear = cint(right(rbuttons(x-1).caption,4)) 'Eyal: changed for OriginalYear
end if
exit for
end if
end if
next
'xdata.custom5 = "Date Corrected" 'Eyal: disabled
xdata.updateDB
End Sub
Sub EvalButtons(r)
if right(r.caption,4) <> "date" then 'there is a date
xdata.originalyear = cint(right(r.caption,4)) 'Eyal: changed for OriginalYear
'xdata.custom5 = "Date Corrected" 'Eyal: disabled
xdata.updateDB
end if
End Sub
'
'
'The following two functions "CleanSearchStringText" and "URLEncodeUTF8" from DiscogsAutoTagWeb script by Let.
'
Function CleanSearchString(Text)
CleanSearchString = Text
CleanSearchString = Replace(CleanSearchString,")", " ") 'remove paranthesis to avoid search errors (discogs bug)
CleanSearchString = Replace(CleanSearchString,"(", " ") 'also clean other unneccessary characters
CleanSearchString = Replace(CleanSearchString,"[", " ")
CleanSearchString = Replace(CleanSearchString,"]", " ")
CleanSearchString = Replace(CleanSearchString,".", " ")
CleanSearchString = Replace(CleanSearchString,"@", " ")
CleanSearchString = Replace(CleanSearchString,"_", " ")
CleanSearchString = Replace(CleanSearchString,"?", " ")
End Function
Function URLEncodeUTF8(ByRef input)
' urlencode a string with UTF8 encoding - yes, it is cryptic but it works!
Dim i, result
result = ""
For i = 1 To Len(input)
CurrentChar = Mid(input, i, 1)
CurrentChar = AscW(CurrentChar)
If (CurrentChar < 0) Then
CurrentChar = CurrentChar + 65536
End If
If (CurrentChar >= 0) And (CurrentChar < 128) Then
' 1 byte
If(CurrentChar = 32) Then
' replace space with "+"
result = result & "+"
Else
' replace punctuation chars with "%hex"
result = result & Escape(Chr(CurrentChar))
End If
End If
If (CurrentChar >= 128) And (CurrentChar < 2048) Then
' 2 bytes
FirstByte = &HC0 Xor ((CurrentChar And &HFFFFFFC0) \ &H40&)
SecondByte = &H80 Xor (CurrentChar And &H3F)
result = result & "%" & Hex(FirstByte) & "%" & Hex(SecondByte)
End If
If (CurrentChar >= 2048) And (CurrentChar < 65536) Then
' 3 bytes
FirstByte = &HE0 Xor (((CurrentChar And &HFFFFF000) \ &H1000&) And &HF)
SecondByte = &H80 Xor (((CurrentChar And &HFFFFFFC0) \ &H40&) And &H3F)
ThirdByte = &H80 Xor (CurrentChar And &H3F)
result = result & "%" & Hex(FirstByte) & "%" & Hex(SecondByte) & "%" & Hex(ThirdByte)
End If
Next
URLEncodeUTF8 = result
End Function