Skip to content

Instantly share code, notes, and snippets.

@rornor
Last active December 22, 2015 02:48
Show Gist options
  • Save rornor/13ebd9e29260a35c8145 to your computer and use it in GitHub Desktop.
Save rornor/13ebd9e29260a35c8145 to your computer and use it in GitHub Desktop.
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