Board logo

标题: [原创] 闽南歌曲下载测试版(vbs) [打印本页]

作者: youxi01    时间: 2007-10-27 17:12     标题: 闽南歌曲下载测试版(vbs)

程序名:闽南歌曲下载测试版(vbs)  Ver1.1(20070806-20070807)
出现背景:各音乐网站提供在线试听的功能,但由于他们都对本网站中的音乐文件地址进行了保护,下载起来稍嫌
麻烦,本程序以MTV1000音乐网为例,自动从源码中分析出音乐文件名、真正地址,然后采用异步Http方式下载。
用途:免费下载闽南歌曲(从MTV1000音乐网),当然也可以不是闽南歌曲,但必须是wma格式的文件,如果不是,自己
对程序进行修改。
使用说明:将下列代码保存为:[文件名].vbe,双击运行
  1. '//程序名:闽南歌曲下载测试版(vbs)  Ver1.1(20070806-20070807)
  2. '//出现背景:各音乐网站提供在线试听的功能,但由于他们都对本网站中的音乐文件地址进行了保护,下载起来稍嫌
  3. '//麻烦,本程序以MTV1000音乐网为例,自动从源码中分析出音乐文件名、真正地址,然后采用异步Http方式下载。
  4. '//用途:免费下载闽南歌曲(从MTV1000音乐网),当然也可以不是闽南歌曲,但必须是wma格式的文件,如果不是,自己
  5. '//      对程序进行修改。
  6. '//用法:将下列代码保存为:[文件名].vbe,双击运行。
  7. '//说明:
  8. '//     1、作者:youxi01,版权没有,欢迎盗版。
  9. '//     2、程序很多地方借鉴了前辈zzzevazzz写的相关wmi技术的内容。
  10. '//     3、支持断点续传,对于已经下载完的文件,不会继续下载覆盖...
  11. '//     4、此版本为测试版,还有很多地方需要完善....
  12. '//     5、水平有限,不足之处,欢迎指正。
  13. on error resume next
  14. Dim url(3)
  15. '//////////自动调用cscript.exe打开/////////////
  16. cmdLine="cmd.exe /c title 闽南歌曲下载测试版--版权没有,欢迎复制 &cscript //nologo "
  17. if (lcase(right(wscript.fullname,11))="wscript.exe") then
  18.    set objShell=wscript.createObject("wscript.shell")
  19.    objShell.Run(cmdLine &wscript.scriptfullname)
  20.    wscript.quit
  21. end if
  22. '///////////////下载三剑客//////////////
  23. set http=wscript.createobject("Microsoft.XMLHTTP")
  24. set fso=wscript.createobject("Scripting.FileSystemObject")
  25. set aso=wscript.createobject("ADODB.Stream")
  26. '////////连接到该网页,将数据转化成GB格式;//////////////////
  27. Function CheckLan(url)
  28. http.open "GET",url,true         '发送网页地址;
  29. http.send
  30. for i=1 to 10                    '循环检测5次,每次0.5秒
  31.   if http.readystate=4 then      '数据接收成功;
  32.       exit for
  33.   end if
  34.   wscript.sleep 500
  35. next
  36. if not http.readystate=4 then    '过了5秒,连个网页都没下载下来,判定为超时;
  37.    wscript.echo "连接服务器超时!请稍后连接..."
  38.    exit function
  39. end if
  40. vIn=http.ResponseBody            '变量接收传回的数据
  41. CheckLan=""
  42. For i = 1 To LenB(vIn)           '以下代码处理数据类型
  43.   ThisCharCode = AscB(MidB(vIn,i,1))
  44.   If ThisCharCode < &H80 Then
  45.      CheckLan=CheckLan & Chr(ThisCharCode)
  46.   Else           '汉字占两个字节               
  47.      NextCharCode = AscB(MidB(vIn,i+1,1))         
  48.      CheckLan=CheckLan & Chr(CLng(ThisCharCode) * &H100 + CInt (NextCharCode))
  49.      i = i + 1
  50.   End If
  51. Next
  52. End Function
  53. '//////////////////======根据传回数据,继续连接相关网页,再次处理返回数据;
  54. Function Connect(url)     
  55. strReturn=CheckLan(url)         
  56. Pos1=instr(strReturn,"歌曲名字")       '从传回结果查询特定字符;
  57. Pos2=instr(strReturn,"全选")
  58. StrLen=Pos2-Pos1
  59. ResStr=mid(strReturn,Pos1,StrLen)      '取这两个字符串之间的内容,只有这些内容才有用;
  60. do
  61.   PathPos=instr(ResStr,"rel")          '根据特定字符来找有用信息(文件名和路径在它们旁边);
  62.   if PathPos>0 then                    '如果还能找到'rel',执行下面的代码;
  63.       MusicPath=mid(ResStr,PathPos-20,18)      '文件路径
  64.       NamePos1=instr(ResStr,"</a>")
  65.       NamePos2=instr(ResStr,"</a></li></ul>")
  66.       Slen=NamePos1-PathPos-15                 '文件名长度
  67.       MusicName=mid(ResStr,PathPos+15,Slen)    '文件名称;
  68.       ResStr=mid(ResStr,NamePos2+12)
  69.    else
  70.       exit do
  71.    end if           
  72.    DownLoad "http://www.mtv1000.com"&MusicPath,MusicName
  73. loop
  74. End Function
  75. '///////////处理数据,找出音乐文件的真正地址,下载音乐文件;
  76. Function DownLoad(url,name)
  77. strReturn=CheckLan(url)
  78. OBJPos1=instr(strReturn,"player(")     '根据特征字符,找出音乐文件真正地址;        
  79. OBJPos2=instr(strReturn,"wma")
  80. OBJLen=OBJPos2-OBJPos1-5
  81. OBJPath=mid(strReturn,OBJPos1+8,OBJLen)
  82. if fso.fileexists(name&".wma") then '判断要下载的文件是否已经存在'
  83.     start=fso.getfile(name&".wma").size '存在,以当前文件大小作为开始位置'
  84. else
  85.     start=0 '不存在,一切从零开始'
  86.     fso.createtextfile(name&".wma").close '新建文件'
  87. end if
  88. current=start
  89. wscript.echo "正在下载文件: 「"&name&".wma」"
  90. wscript.echo
  91. do
  92. http.open "GET","http://t.mtv1000.com:81"&OBJPath,true     '发送下载数据,一直到接收完毕;
  93. http.setrequestheader "Range","bytes="&start&"-"&cstr(start+20480)  
  94. http.setrequestheader "Content-Type:","application/octet-stream"
  95. http.send
  96. for i=1 to 120                          '一分钟还没下完20KB,K掉!
  97.    if http.readystate=4 then exit for
  98.    wscript.sleep 500
  99. next
  100. If http.status=416 Then Exit do       '判断文件是否已经下载完毕!
  101. aso.type=1
  102. aso.open
  103. aso.loadfromfile name&".wma"
  104. aso.position=start
  105. aso.write http.responsebody
  106. aso.savetofile name&".wma",2
  107. aso.close
  108. range=http.getresponseheader("Content-Range")        '获得http头中的"Content-Range"'
  109. temp=mid(range,instr(range,"-")+1)
  110. current=clng(left(temp,instr(temp,"/")-1))           '当前已下载大小(字节)
  111. total=clng(mid(temp,instr(temp,"/")+1))              '文件总大小
  112. if total-current=1 then exit do                      '下载完成;
  113. start=start+20480                                    '再下载20KB
  114. progress="   进度:"&cint(current/total*100)&"%"
  115. finish="  完成:"&cint(current/1024)&"/"&cint(total/1024)&" KB" &total
  116. wscript.stdout.write chr(13)&finish&progress&chr(8)
  117. loop while true
  118. wscript.echo
  119. wscript.echo "  「"&name&".wma」"&" 下载完成"
  120. wscript.echo
  121. End Function
  122. '/////////////去下载吧/////////////////
  123. Turl="http://www.mtv1000.com/musiclist/"      '主网站
  124. url(0)=Turl&"3667.html"                       '要下载的主页面地址(自己可以修改);
  125. url(1)=Turl&"3674.html"
  126. url(2)=Turl&"3678.html"
  127. url(3)=Turl&"3692.html"
  128. For i=0 to 3                                  '给我不停的去连接啊
  129.    Connect(url(i))
  130. next
复制代码

作者: somebody    时间: 2007-11-3 00:28


先过我卡巴这一关再说...................
这个下载的VBS..能过卡巴的话,我以前还用得着在某个群里跟那个贱人求了N 久的代码,搞到差点打起来.........................我要的是加密版的VBS下载代码,要能绕过卡巴查杀的......
作者: 千浪    时间: 2008-1-23 11:57

找了好久..原来在这里啊..




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2