回複:前幾天,poiuyt 推薦了一個下載音樂的程序。可我的電腦裏的McAfee總是自動地給delete了。我可怎麽辦?

  • 原程序轉帖而來,不過virus free是可以保證的。否則寥寥百十行如果真有virus,KD眾高手也一定會看出來。
  • 可考慮先按piaoyao說的辦法修改McAfee的設置,然後試試下麵的新版(字符串http://被隱藏了,但願它就是McAfee指認的virus
  • <html>
    <title>Music downloader</title>
    <head>
    <HTA:APPLICATION
     SINGLEINSTANCE="yes"
     BORDER="thin"
    />
    </head>
    <script language="VBScript">
    Option Explicit
     Dim https
     https="h"&"t"&"t"&"p"&":"&"/"&"/"
    Sub Window_OnLoad
      'bbs.wenxuecity.com/music-album/630946.html
      'bbs.wenxuecity.com/music-album/637616.html
     url2.value=https&"bbs.wenxuecity.com/music-album/630946.html"
     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
      Set Matches = RegExpMatches("playlist_url=[""']?(.*?\.xspf)", 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) ' This number needs to be reviewed
      URL = Match.SubMatches.Item(0)
      PrintText "<br>Playlist = "+URL,True
      Content = GetURL(URL)
      PrintText Content&"<br/>",True
     Next
     Set Matches = RegExpMatches(https&"[\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>
     <input class="button" TYPE=BUTTON value="Download" name="btnTestButton"  onClick="ButtonClick">
     <span id = "TextArea"></span>
    </body>
    </html>

請您先登陸,再發跟帖!