Skip to content

@rornor /re_allmusic.vbs secret
Last active

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
foobar2000, Biography View script that can be used to display artist biography and album review according allmusic.com scrapped with regex.
Cache = 1 ' set to 0 to turn caching off
Set Arg = WScript.Arguments
If Cache Then Set oXml = CreateObject("MSXML2.DOMDocument.6.0")
If Arg.Count <> 3 Then
WScript.Echo "Usage: cscript //nologo re_allmusic.vbs ""%album artist%"" ""%album%"" review|bio"
WScript.Quit()
Else
If Arg(0) <> "?" And Arg(1) <> "?" Then
id = md5(Arg(0) & Arg(1))
If Not CacheCheck Then
If Arg(2) = "skip" Then
CacheUpdate("")
Else
Dim albumLink, artistLink
If Len(Arg(1)) < 3 Then query = Arg(1) & " " & Arg(0) : Else query = Arg(1) End If
content = search(arg(2))
If content <> "" Then
WScript.Echo content
If Cache Then CacheUpdate content
End If
End If
End If
End If
End If
Function search(result)
Set dAlbum = CreateObject("Scripting.Dictionary")
With New RegExp
.IgnoreCase = True
.Global = True
.Pattern = "</h4>[\s\S]+?href=""([^""]+?)"".*?>(.*?)<[\s\S]+?href=""([^""]+?)"".*?>(.*?)<"
Set reMatch = .Execute(Request("http://www.allmusic.com/search/albums/" & Escape(query)))
For Each m in reMatch
If Not dAlbum.Exists(m.Submatches(0) & "~~" & m.Submatches(1)) Then dAlbum.Add m.Submatches(0) & "~~" & m.Submatches(1), m.Submatches(2) & "~~" & m.Submatches(3)
Next
End With
For Each k In dAlbum.Keys
If Match(Split(k, "~~")(1), query) And Match(Split(dAlbum(k), "~~")(1), Arg(0)) Then
artistLink = Split(dAlbum(k), "~~")(0) & "/biography"
albumLink = Split(k, "~~")(0)
If result = "bio" Then
search = biography(artistLink)
Else
search = review(albumLink)
End If
Exit For
End If
Next
End Function
Function review(url)
With New RegExp
.IgnoreCase = True
.Global = True
.Pattern = "Review[\s]+?by <.*?>(.*?)<[\s\S]+?(<p[\s\S]*/p>)"
Set reMatch = .Execute(Request(url))
If reMatch.Count > 0 Then review = striptEmptySpace(striptHtmlTags(reMatch.Item(0).Submatches(1))) & vbCrLf & vbCrLf & "Review by " & reMatch.Item(0).Submatches(0)
End With
End Function
Function biography(url)
With New RegExp
.IgnoreCase = True
.Global = True
.Pattern = "Artist Biography\n[\s]+?by <.*?>(.*?)<[\s\S]+?(<div[\s\S]*/section>)"
Set reMatch = .Execute(Request(url))
If reMatch.Count > 0 Then biography = striptEmptySpace(striptHtmlTags(reMatch.Item(0).Submatches(1))) & vbCrLf & vbCrLf & "Biography by " & reMatch.Item(0).Submatches(0)
End With
End Function
Function striptHtmlTags(s)
With New RegExp
.Global = True
.Pattern = "<[^>]+>"
striptHtmlTags = .Replace(s, "")
End With
End Function
Function striptEmptySpace(s)
With New RegExp
.Global = True
.Pattern = "[\s]+"
striptEmptySpace = Trim(.Replace(s, " "))
End With
End Function
Function CacheCheck
If Cache Then
Set oFS = CreateObject("Scripting.FileSystemObject")
If Not oFS.FileExists("foo_allmusic.xml") Then
oXml.loadXML "<?xml version='1.0' encoding='UTF-8'?><Items></Items>"
oXml.save "foo_allmusic.xml"
Else
oXml.load "foo_allmusic.xml"
Set nod = oXml.selectSingleNode("Items/Item[@Id='" & id & "']/" & Arg(2))
If Not nod Is Nothing Then
If Arg(2) <> "skip" Then WScript.Echo nod.text
CacheCheck = True
Else
Set nod = oXml.selectSingleNode("Items/Item[@Id='" & id & "']/skip")
If Not nod Is Nothing Then CacheCheck = True
End If
End If
End If
End Function
Sub CacheUpdate(t)
oXml.load "foo_allmusic.xml"
Set root = oXml.selectSingleNode("Items")
Set item = oXml.selectSingleNode("Items/Item[@Id='" & id & "']")
If item Is Nothing Then
Set item = oXml.createElement("Item")
item.setAttribute "Id", id
artistId = "mn0000000000" : AlbumId = "mw0000000000"
If TypeName(artistLink) = "String" Then ArtistId = Right(Replace(artistLink, "/biography", ""), 12)
If TypeName(albumLink) = "String" Then AlbumId = Right(albumLink, 12)
item.setAttribute "ArtistId", ArtistId
item.setAttribute "AlbumId", AlbumId
Set comment = oXml.createComment(Arg(0) & " // " & Arg(1))
item.appendChild comment
root.appendChild item
End If
Set data = oXml.createElement(Arg(2))
data.Text = t
item.appendChild data
oXml.save "foo_allmusic.xml"
End Sub
Function Request(URL)
Set HTTP = CreateObject("MSXML2.XMLHTTP")
On Error Resume Next
HTTP.open "GET", URL, False
HTTP.send ""
If Not CBool(Err.Number) Then resp = HTTP.responseText
On Error Goto 0
Request = resp
End Function
Function Match(s1, s2)
If InStr(LCase(Replace(s1, " ", "")), LCase(Replace(s2, " ", ""))) > 0 Or _
InStr(LCase(Replace(s2, " ", "")), LCase(Replace(s1, " ", ""))) > 0 Then
Match = True
Else Match = False End If
End Function
Function md5(s)
Set MDC = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
Set UTF = CreateObject("System.Text.UTF8Encoding")
hash = MDC.ComputeHash_2((UTF.GetBytes_4(s)))
For i = 1 To Lenb(hash)
md5 = md5 & LCase(Right("0" & Hex(Ascb(Midb(hash, i, 1))), 2))
Next
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.