[原创] 闽南歌曲下载测试版(vbs)

youxi01

程序名：闽南歌曲下载测试版(vbs)  Ver1.1(20070806-20070807)
出现背景：各音乐网站提供在线试听的功能，但由于他们都对本网站中的音乐文件地址进行了保护，下载起来稍嫌
麻烦，本程序以MTV1000音乐网为例，自动从源码中分析出音乐文件名、真正地址，然后采用异步Http方式下载。
用途：免费下载闽南歌曲(从MTV1000音乐网),当然也可以不是闽南歌曲，但必须是wma格式的文件，如果不是，自己
对程序进行修改。
使用说明：将下列代码保存为：[文件名].vbe，双击运行

'//程序名：闽南歌曲下载测试版(vbs)  Ver1.1(20070806-20070807)
'//出现背景：各音乐网站提供在线试听的功能，但由于他们都对本网站中的音乐文件地址进行了保护，下载起来稍嫌
'//麻烦，本程序以MTV1000音乐网为例，自动从源码中分析出音乐文件名、真正地址，然后采用异步Http方式下载。
'//用途：免费下载闽南歌曲(从MTV1000音乐网),当然也可以不是闽南歌曲，但必须是wma格式的文件，如果不是，自己
'//      对程序进行修改。
'//用法：将下列代码保存为：[文件名].vbe，双击运行。
'//说明：
'//     1、作者：youxi01,版权没有，欢迎盗版。
'//     2、程序很多地方借鉴了前辈zzzevazzz写的相关wmi技术的内容。
'//     3、支持断点续传，对于已经下载完的文件，不会继续下载覆盖...
'//     4、此版本为测试版，还有很多地方需要完善....
'//     5、水平有限，不足之处，欢迎指正。
on error resume next
Dim url(3)

'//////////自动调用cscript.exe打开/////////////
cmdLine="cmd.exe /c title 闽南歌曲下载测试版--版权没有，欢迎复制 &cscript //nologo "
if (lcase(right(wscript.fullname,11))="wscript.exe") then
   set objShell=wscript.createObject("wscript.shell") 
   objShell.Run(cmdLine &wscript.scriptfullname)
   wscript.quit
end if

'///////////////下载三剑客//////////////
set http=wscript.createobject("Microsoft.XMLHTTP") 
set fso=wscript.createobject("Scripting.FileSystemObject")
set aso=wscript.createobject("ADODB.Stream")


'////////连接到该网页,将数据转化成GB格式;//////////////////
Function CheckLan(url)
http.open "GET",url,true         '发送网页地址；
http.send 
for i=1 to 10                    '循环检测5次，每次0.5秒
  if http.readystate=4 then      '数据接收成功；
      exit for
  end if
  wscript.sleep 500
next

if not http.readystate=4 then    '过了5秒，连个网页都没下载下来，判定为超时；
   wscript.echo "连接服务器超时!请稍后连接..."
   exit function
end if

vIn=http.ResponseBody            '变量接收传回的数据
CheckLan=""

For i = 1 To LenB(vIn)           '以下代码处理数据类型
  ThisCharCode = AscB(MidB(vIn,i,1)) 
  If ThisCharCode < &H80 Then
     CheckLan=CheckLan & Chr(ThisCharCode)
  Else           '汉字占两个字节               
     NextCharCode = AscB(MidB(vIn,i+1,1))         
     CheckLan=CheckLan & Chr(CLng(ThisCharCode) * &H100 + CInt (NextCharCode))
     i = i + 1
  End If
Next
End Function

'//////////////////======根据传回数据，继续连接相关网页，再次处理返回数据；
Function Connect(url)     
strReturn=CheckLan(url)         

Pos1=instr(strReturn,"歌曲名字")       '从传回结果查询特定字符；
Pos2=instr(strReturn,"全选")
StrLen=Pos2-Pos1
ResStr=mid(strReturn,Pos1,StrLen)      '取这两个字符串之间的内容，只有这些内容才有用；

do
  PathPos=instr(ResStr,"rel")          '根据特定字符来找有用信息(文件名和路径在它们旁边)；

  if PathPos>0 then                    '如果还能找到'rel'，执行下面的代码；
      MusicPath=mid(ResStr,PathPos-20,18)      '文件路径
      NamePos1=instr(ResStr,"</a>")
      NamePos2=instr(ResStr,"</a></li></ul>")
      Slen=NamePos1-PathPos-15                 '文件名长度
      MusicName=mid(ResStr,PathPos+15,Slen)    '文件名称；
      ResStr=mid(ResStr,NamePos2+12)
   else 
      exit do
   end if           
   DownLoad "http://www.mtv1000.com"&MusicPath,MusicName
loop
End Function

'///////////处理数据，找出音乐文件的真正地址，下载音乐文件;
Function DownLoad(url,name)
strReturn=CheckLan(url)

OBJPos1=instr(strReturn,"player(")     '根据特征字符，找出音乐文件真正地址；        
OBJPos2=instr(strReturn,"wma")
OBJLen=OBJPos2-OBJPos1-5
OBJPath=mid(strReturn,OBJPos1+8,OBJLen)

if fso.fileexists(name&".wma") then '判断要下载的文件是否已经存在' 
    start=fso.getfile(name&".wma").size '存在，以当前文件大小作为开始位置' 
else 
    start=0 '不存在，一切从零开始' 
    fso.createtextfile(name&".wma").close '新建文件' 
end if 

current=start
wscript.echo "正在下载文件： 「"&name&".wma」"
wscript.echo

do 

http.open "GET","http://t.mtv1000.com:81"&OBJPath,true     '发送下载数据，一直到接收完毕；
http.setrequestheader "Range","bytes="&start&"-"&cstr(start+20480)  
http.setrequestheader "Content-Type:","application/octet-stream" 
http.send

for i=1 to 120                          '一分钟还没下完20KB，K掉！
   if http.readystate=4 then exit for
   wscript.sleep 500
next

If http.status=416 Then Exit do       '判断文件是否已经下载完毕!

aso.type=1
aso.open
aso.loadfromfile name&".wma"
aso.position=start
aso.write http.responsebody
aso.savetofile name&".wma",2 
aso.close

range=http.getresponseheader("Content-Range")        '获得http头中的"Content-Range"' 
temp=mid(range,instr(range,"-")+1)
current=clng(left(temp,instr(temp,"/")-1))           '当前已下载大小(字节)
total=clng(mid(temp,instr(temp,"/")+1))              '文件总大小
if total-current=1 then exit do                      '下载完成；
start=start+20480                                    '再下载20KB

progress="   进度："&cint(current/total*100)&"%"
finish="  完成："&cint(current/1024)&"/"&cint(total/1024)&" KB" &total
wscript.stdout.write chr(13)&finish&progress&chr(8)
loop while true
wscript.echo
wscript.echo "  「"&name&".wma」"&" 下载完成"
wscript.echo
End Function

'/////////////去下载吧/////////////////
Turl="http://www.mtv1000.com/musiclist/"      '主网站
url(0)=Turl&"3667.html"                       '要下载的主页面地址(自己可以修改);
url(1)=Turl&"3674.html"
url(2)=Turl&"3678.html"
url(3)=Turl&"3692.html"

For i=0 to 3                                  '给我不停的去连接啊
   Connect(url(i))
next
复制代码

somebody

先过我卡巴这一关再说...................
这个下载的VBS..能过卡巴的话，我以前还用得着在某个群里跟那个贱人求了N 久的代码，搞到差点打起来.........................我要的是加密版的VBS下载代码，要能绕过卡巴查杀的......

千浪

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