推薦一個下載程序

Just need 4 steps.

  1. Create a directory, like C:\music
  2. Copy this code and paste into an editor like NOTEPAD
  3. <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>

  4. Save the file in the directory created above, naming it download.hta (Be careful here not to save as .txt)
  5. Double-click download.hta, paste a YYKD link and click [Download]

所有跟帖: 

沾LZ的光,用上了,太感謝你了 -天兒晴了- 給 天兒晴了 發送悄悄話 天兒晴了 的博客首頁 (0 bytes) () 01/07/2012 postreply 15:45:22

再接著問個問題,你一直不能聽none的帖子,瀏覽器已經是最新版本了,還能有什麽其他原因嗎? -天兒晴了- 給 天兒晴了 發送悄悄話 天兒晴了 的博客首頁 (0 bytes) () 01/07/2012 postreply 15:46:58

回複:再接著問個問題,你一直不能聽none的帖子,瀏覽器已經是最新版本了,還能有什麽其他原因嗎? -none- 給 none 發送悄悄話 none 的博客首頁 (175 bytes) () 01/08/2012 postreply 08:30:36

我是不是笨得夠可以?你給的那個連接打不開,連著試了N多次。 -天兒晴了- 給 天兒晴了 發送悄悄話 天兒晴了 的博客首頁 (0 bytes) () 01/08/2012 postreply 08:59:52

回複:我是不是笨得夠可以?你給的那個連接打不開,連著試了N多次。 -none- 給 none 發送悄悄話 none 的博客首頁 (137 bytes) () 01/08/2012 postreply 09:44:54

試過了,不行,就此放棄吧。多謝你一次又一次幫我 -天兒晴了- 給 天兒晴了 發送悄悄話 天兒晴了 的博客首頁 (0 bytes) () 01/08/2012 postreply 10:36:34

通常聽不了個別帖子恰恰是因為瀏覽器是最新版本。 -poiuyt- 給 poiuyt 發送悄悄話 (177 bytes) () 01/08/2012 postreply 10:25:08

嗬, 真高手也 ~~~~ -piaoyao- 給 piaoyao 發送悄悄話 (0 bytes) () 01/07/2012 postreply 21:21:21

更新版本 -poiuyt- 給 poiuyt 發送悄悄話 poiuyt 的博客首頁 (14924 bytes) () 10/20/2012 postreply 07:33:50

請您先登陸,再發跟帖!