批处理之家 - Powered by Discuz! Board

'//程序名：闽南歌曲下载测试版(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