Board logo

标题: [原创] 某网站视频下载器 [打印本页]

作者: youxi01    时间: 2009-10-21 13:12     标题: 某网站视频下载器

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


源代码:
  1. ON ERROR RESUME NEXT
  2. Set HTTP=Wscript.CreateObject("Microsoft.XMLHTTP")
  3. Set FSO=Wscript.CreateObject("Scripting.FileSystemObject")
  4. Set ASO=Wscript.CreateObject("ADODB.Stream")
  5. '/*/////////////////////////////////////////////////////////
  6. '*MadeTime: 2009-10-21
  7. '*LastModify: 2009-10-21
  8. '*功能: 异步下载网络文件
  9. '*参数: 文件地址;文件保存名
  10. '**********************************************************
  11. Function DownLoadFile(FileURL,NameAs)
  12. IF FSO.FileExists(NameAs) Then
  13. Start=FSO.GetFile(NameAs).size
  14. else
  15. Start=0
  16. FSO.CreateTextFile(NameAs).Close
  17. End IF
  18. Current=Start
  19. Do
  20. HTTP.open "GET",FileURL,true     '发送下载数据
  21. HTTP.setrequestheader "Range","bytes="&start&"-"&cstr(start+20480)  
  22. HTTP.setrequestheader "Content-Type:","application/octet-stream"
  23. HTTP.send
  24. For i=1 to 120
  25.   IF HTTP.ReadyState=4 then Exit For
  26.       wscript.sleep 500
  27. Next
  28. IF HTTP.status=416 Then Exit Do
  29. With ASO
  30.   .type=1
  31.   .open
  32.   .loadfromfile NameAs        
  33.   .position=start
  34.   .write HTTP.ResponseBody
  35.   .savetofile NameAs,2
  36.   .close
  37. End With
  38. Range=HTTP.getresponseheader("Content-Range") '获得HTTP头中的"Content-Range"'
  39. Temp=mid(Range,instr(Range,"-")+1)
  40. Current=clng(Left(Temp,instr(Temp,"/")-1)) '当前已下载大小(字节)
  41. Total=clng(mid(Temp,instr(Temp,"/")+1))  '文件总大小
  42. IF Total-Current=1 then    '下载完成
  43.   Msgbox "下载完成!",VBInformation+vbokonly,"Video DownLoador"
  44.   Exit Do
  45. End IF  
  46. Start=Start+20480
  47. Loop While True
  48. End Function
  49. '/*/////////////////////////////////////////////////////////
  50. '*MadeTime: 2009-10-21
  51. '*LastModify: 2009-10-21
  52. '*功能: 获取指定网页源代码
  53. '*参数: 网页地址
  54. '**********************************************************
  55. Function GetURLCode(URL)
  56. HTTP.open "GET",URL,true         '发送网页地址;
  57. HTTP.send
  58. For i=1 To 10                    '循环检测10次,每次0.5秒
  59.   if HTTP.readystate=4 then      '数据接收成功;
  60.       Exit For
  61.   End IF
  62.   Wscript.sleep 500
  63. Next
  64. IF not HTTP.Readystate=4 then
  65.    Msgbox "网络连接超时",vbInformation+vbokonly,"Video DownLoador"
  66.    Wscript.quit
  67. End IF
  68. SourceStr=HTTP.ResponseBody            '变量接收传回的数据
  69. Temp=Bytes2Str(SourceStr,"utf-8")
  70. CharSet=MyRegExp("charset=['""]?([a-zA-Z0-9\-]+)['""]",Temp)
  71. IF CharSet="" Then CharSet="gb2312"
  72. GetURLCode=Bytes2Str(SourceStr,CharSet)
  73. End Function
  74. '/*/////////////////////////////////////////////////////////
  75. '*MadeTime: 2009-10-21
  76. '*LastModify: 2009-10-21
  77. '*功能: 根据charset值转换网页数据
  78. '*参数: 待处理数据;CharSet类型
  79. '**********************************************************
  80. Function Bytes2Str(Body,Cset)
  81. With ASO
  82. .Type = 1
  83. .Mode =3
  84. .Open
  85. .Write body
  86. .Position = 0
  87. .Type = 2
  88. .Charset=Cset
  89. Bytes2str=.ReadText
  90. .Close
  91. End With
  92. End Function
  93. '/*/////////////////////////////////////////////////////////
  94. '*MadeTime: 2009-10-21
  95. '*LastModify: 2009-10-21
  96. '*功能: 提取内容正则表达式
  97. '*参数: 正则表达式;待处理数据对象
  98. '**********************************************************
  99. Function MyRegExp(Patrn,Strng)
  100. Set RegEx1=New RegExp
  101. With RegEx1
  102. .Pattern = Patrn
  103. .IgnoreCase=True     
  104. .Global=True
  105. End With
  106. Set Matches =RegEx1.Execute(strng)
  107. IF Matches.Count>0 then
  108. MyRegExp=Matches(0).subMatches(0)
  109. Else
  110. MyRegExp=""
  111. End IF
  112. End Function
  113. MyStr=GetURLCode("http://hxzyk.net/Item/681.aspx")
  114. FileInfo=MyRegExp("(UploadFiles.*flv)",MyStr)
  115. FileURL="http://hxzyk.net/" & FileInfo
  116. FileInfo=split(FileInfo,"/")
  117. FileName=FileInfo(Ubound(FileInfo))
  118. DownLoadFile FileURL,FileName
  119. Set HTTP=Nothing
  120. Set FSO=Nothing
  121. Set ASO=Nothing
复制代码

作者: 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

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




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