secret
Last active

foobar2000, Biography View script that can be used to display artist biography and album review according allmusic.com scrapped with regex.

  • Download Gist
re_allmusic.vbs
Visual Basic
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.