Just need 4 steps.
- Create a directory, like C:\music
- Copy this code and paste into an editor like NOTEPAD
- Save the file in the directory created above, naming it download.hta (Be careful here not to save as .txt)
- Double-click download.hta, paste a YYKD link and click [Download]
<html>
<title>Music downloader</title>
<head>
<HTA:APPLICATION
SINGLEINSTANCE="yes"
BORDER="thin"
/>
</head>
<script language="VBScript">
Option Explicit
Sub Window_OnLoad
url2.focus
url2.select
moveto screen.width/2 - 650/2,screen.height/2 - 550/2
resizeto 650,550
End Sub
Sub PrintText(Text,Flag)
TextArea.InnerHTML = TextArea.InnerHTML & Text
If Flag Then
TextArea.InnerHTML = TextArea.InnerHTML & "<br>"
End If
document.body.doScroll("pageDown")
Sleep 10
End Sub
Function GetURL(URL)
Dim http
Set http = CreateObject("Microsoft.XmlHttp")
http.open "GET", URL, False
http.send ""
GetURL=http.ResponseText
End Function
Function GetURLBinary(URL)
Dim http
Set http = CreateObject("Microsoft.XmlHttp")
http.open "GET", URL, True
http.send ""
Do While (http.readyState <> 4) 'http.status <> 200) 'http.readyState <> 4 Or
Sleep 2000
Loop
If (http.status = 200) Then
GetURLBinary=http.ResponseBody
End If
End Function
Function RegExpMatches(patrn, strng)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
regEx.Global = True
Set RegExpMatches = regEx.Execute(strng)
End Function
Function ReplaceString(Str, patrn, replStr)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
ReplaceString = regEx.Replace(Str, replStr)
End Function
Sub WriteBinary(bstr, path)
Dim bs
Set bs = CreateObject("ADODB.Stream")
bs.Type = 1
bs.Open
bs.Write bstr
bs.SaveToFile path, 2
End Sub
Sub Sleep(MSecs)
Dim fso, objOutputFile
Set fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists("helper.vbs")=False Then
Set objOutputFile = fso.CreateTextFile("helper.vbs", True)
objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
objOutputFile.Close
End If
CreateObject("WScript.Shell").Run "helper.vbs "&MSecs,1,True
End Sub
Sub ButtonClick
Dim URL, File, Content, Match, Matches
URL = url2.value
'PrintText "URL = "+URL,True
Content = GetURL(URL)
Set Matches = RegExpMatches("file=(.*?\.xml)", Content)
If Matches.Count = 0 Then
Set Matches = RegExpMatches("src=""?(.*?\.m3u)", Content)
End If
If Matches.Count = 0 Then
PrintText "No playlist found. Now trying to download from the post",True
End If
For Each Match in Matches
URL = Mid(Match.Value,6)
PrintText "<br>Playlist = "+URL,True
Content = GetURL(URL)
PrintText Content&"<br/>",True
Next
Set Matches = RegExpMatches("http://[\w\d:#@%/;$()~_?\+=\\\.&-]*\.(mp3|wma)", Content)
For Each Match in Matches
URL=Match.Value
If (File = "") Then
PrintText "***** Files in "&CreateObject("wscript.shell").CurrentDirectory&"<br/>",True
End If
File = ReplaceString(URL, ".*/", "")
PrintText "Downloading "+URL+" ... ",False
URL=GetURLBinary(URL)
If (LenB(URL) = 0) Then
PrintText "Not found",True
Else
WriteBinary URL, File
PrintText "Done",True
End If
Next
If Matches.Count <> 0 Then
PrintText "<br/>Enjoy the music!",True
Else
PrintText "No music files found.",True
End If
End Sub
</script>
<body STYLE="color:white;
filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
<input type="text" name="url2" size=70 value="http://bbs.wenxuecity.com/music-album/630946.html">
<input class="button" TYPE=BUTTON value="Download" name="btnTestButton" onClick="ButtonClick">
<span id = "TextArea"></span>
</body>
</html>
