批处理之家 » VBS原创&转载 » 某网站视频下载器

youxi01 发表于 2009-10-21 13:12

某网站视频下载器

功能：自动分析相关网页源码，从源码中提取出视频地址和文件名，然后将之下载下来。
计划将本程序改装成hta程序，添加到IE右键菜单（项目名称：下载网页上的视频），以后如需要下载该网站的视频，只需要打开相应的网页，然后在该网页上右击，然后点击"下载网页上的视频"，便可以将需要的视频下载到本地。


源代码：[code]ON ERROR RESUME NEXT
Set HTTP=Wscript.CreateObject("Microsoft.XMLHTTP")
Set FSO=Wscript.CreateObject("Scripting.FileSystemObject")
Set ASO=Wscript.CreateObject("ADODB.Stream")

'/*/////////////////////////////////////////////////////////
'*MadeTime： 2009-10-21
'*LastModify: 2009-10-21
'*功能： 异步下载网络文件
'*参数： 文件地址；文件保存名
'**********************************************************
Function DownLoadFile(FileURL,NameAs)
IF FSO.FileExists(NameAs) Then
Start=FSO.GetFile(NameAs).size
else
Start=0
FSO.CreateTextFile(NameAs).Close
End IF
Current=Start
Do
HTTP.open "GET",FileURL,true     '发送下载数据
HTTP.setrequestheader "Range","bytes="&start&"-"&cstr(start+20480)  
HTTP.setrequestheader "Content-Type:","application/octet-stream"
HTTP.send
For i=1 to 120
  IF HTTP.ReadyState=4 then Exit For
      wscript.sleep 500
Next
IF HTTP.status=416 Then Exit Do
With ASO
  .type=1
  .open
  .loadfromfile NameAs        
  .position=start
  .write HTTP.ResponseBody
  .savetofile NameAs,2
  .close
End With
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    '下载完成
  Msgbox "下载完成!",VBInformation+vbokonly,"Video DownLoador"
  Exit Do
End IF  
Start=Start+20480
Loop While True
End Function
'/*/////////////////////////////////////////////////////////
'*MadeTime： 2009-10-21
'*LastModify: 2009-10-21
'*功能： 获取指定网页源代码
'*参数： 网页地址
'**********************************************************
Function GetURLCode(URL)
HTTP.open "GET",URL,true         '发送网页地址；
HTTP.send
For i=1 To 10                    '循环检测10次，每次0.5秒
  if HTTP.readystate=4 then      '数据接收成功；
      Exit For
  End IF
  Wscript.sleep 500
Next
IF not HTTP.Readystate=4 then
   Msgbox "网络连接超时",vbInformation+vbokonly,"Video DownLoador"
   Wscript.quit
End IF
SourceStr=HTTP.ResponseBody            '变量接收传回的数据
Temp=Bytes2Str(SourceStr,"utf-8")
CharSet=MyRegExp("charset=['""]?([a-zA-Z0-9\-]+)['""]",Temp)
IF CharSet="" Then CharSet="gb2312"
GetURLCode=Bytes2Str(SourceStr,CharSet)
End Function

'/*/////////////////////////////////////////////////////////
'*MadeTime： 2009-10-21
'*LastModify: 2009-10-21
'*功能： 根据charset值转换网页数据
'*参数： 待处理数据；CharSet类型
'**********************************************************
Function Bytes2Str(Body,Cset)
With ASO
.Type = 1
.Mode =3
.Open
.Write body
.Position = 0
.Type = 2
.Charset=Cset
Bytes2str=.ReadText
.Close
End With
End Function
'/*/////////////////////////////////////////////////////////
'*MadeTime： 2009-10-21
'*LastModify: 2009-10-21
'*功能： 提取内容正则表达式
'*参数： 正则表达式；待处理数据对象
'**********************************************************
Function MyRegExp(Patrn,Strng)
Set RegEx1=New RegExp
With RegEx1
.Pattern = Patrn
.IgnoreCase=True     
.Global=True
End With
Set Matches =RegEx1.Execute(strng)
IF Matches.Count>0 then
MyRegExp=Matches(0).subMatches(0)
Else
MyRegExp=""
End IF
End Function
MyStr=GetURLCode("http://hxzyk.net/Item/681.aspx")
FileInfo=MyRegExp("(UploadFiles.*flv)",MyStr)
FileURL="http://hxzyk.net/" & FileInfo
FileInfo=split(FileInfo,"/")
FileName=FileInfo(Ubound(FileInfo))
DownLoadFile FileURL,FileName
Set HTTP=Nothing
Set FSO=Nothing
Set ASO=Nothing[/code]

qq191035066 发表于 2009-10-21 17:16

三氧化硫的制备.flv
这就是我下的，呵呵

asnahu 发表于 2009-10-21 21:02

断点续传，有点意思。

athinko 发表于 2009-10-21 22:07

看不东
。。。。。。

conconcon1 发表于 2009-11-15 15:50

这个很有创意很实用的东西

查看完整版本: 某网站视频下载器