批处理之家 - Powered by Discuz! Board

标题: [问题求助] [已解决]vbs如何实现从网页中获取qq最新版本的下载链接并下载到指定目录？ [打印本页]

作者: ygqiang 时间: 2016-4-1 18:38 标题: [已解决]vbs如何实现从网页中获取qq最新版本的下载链接并下载到指定目录？

本帖最后由 ygqiang 于 2016-4-1 21:33 编辑

[已解决]vbs如何实现从网页中获取qq最新版本的下载链接并下载到指定目录？

1、exe软件原来是啥名字，下载下来就是啥名字。
2、exe软件下载到vbs文件所在的目录下。

实现目的：定期/全自动/傻瓜化下载最新版本的qq

Set http=CreateObject("winhttp.winhttprequest.5.1")

http.Open "GET","http://im.qq.com/pcqq/",False
http.Send
Set re=New RegExp
re.Pattern="href=""(.{1,50}exe)"""
downloadurl=re.Execute(http.ResponseText)(0).submatches(0)
http.Open "GET",downloadurl,False
http.Send
Set objtemp = CreateObject("ADODB.Stream")
objtemp.open 
objtemp.Type = 1
objtemp.Write http.responsebody
objtemp.SaveToFile "c:\000\qq.exe", 2
objtemp.Close
Set objTemp=Nothing
'MsgBox "下载完成,保存在c:\000\qq.exe"
复制代码

作者: WHY 时间: 2016-4-1 19:27

re.Pattern="href=""(.+/(.+?\.exe))"""
Set objMatch = re.Execute(http.ResponseText)(0)
http.Open "GET",objMatch.submatches(0),False
...
objtemp.SaveToFile objMatch.submatches(1), 2
复制代码

作者: codegay 时间: 2016-4-1 20:00

#="""
julia自动下载QQ.jl
2016年4月1日 19:16:15 codegay
"""=#
url=string("http://im.qq.com/pcqq/","?",time())
download(url,"qq.html")
f=open("qq.html")
txt=readall(f)
m=matchall(r"(?P<test>http://.*?.exe)",txt)
fn=split(m[1],"/")
download(m[1],fn[end])
复制代码

作者: ygqiang 时间: 2016-4-1 20:35

本帖最后由 ygqiang 于 2016-4-4 08:33 编辑

回复 2# WHY

多谢。解决了。。

1、exe软件原来是啥名字，下载下来就是啥名字。
2、exe软件下载到vbs文件所在的目录下。
3、如果已经存在exe同名/同体积软件，就不下载exe软件

Set http=CreateObject("winhttp.winhttprequest.5.1")

http.Open "GET","http://im.qq.com/pcqq/",False
http.Send
Set re=New RegExp
re.Pattern="href=""(.+/(.+?\.exe))"""
Set objMatch = re.Execute(http.ResponseText)(0)
If CreateObject("Scripting.FileSystemObject").FileExists(objMatch.submatches(1)) Then Wscript.Quit
'MsgBox "存在同名"
'MsgBox "不存在同名"
downloadurl=re.Execute(http.ResponseText)(0).submatches(0)
http.Open "GET",objMatch.submatches(0),False
http.Send
Set objtemp = CreateObject("ADODB.Stream")
objtemp.open 
objtemp.Type = 1
objtemp.Write http.responsebody
objtemp.SaveToFile objMatch.submatches(1), 2
objtemp.Close
Set objTemp=Nothing
'MsgBox "下载完成"
复制代码

作者: pcl_test 时间: 2016-4-1 21:54

If CreateObject("Scripting.FileSystemObject").FileExists(objMatch.submatches(1)) Then Wscript.Quit
复制代码

作者: ygqiang 时间: 2016-4-1 23:04

本帖最后由 ygqiang 于 2016-4-1 23:09 编辑

回复 5# pcl_test

多谢。应该放在7和8之间吧？

作者: ygqiang 时间: 2016-4-2 09:41

回复 5# pcl_test

请教下，什么条件下，这个vbs代码会失效？
不能下载最新qq版本了？

作者: codegay 时间: 2016-4-2 19:28

回复 7# ygqiang

老老实实把找门语言从基本学起啦.有基础看其它代码像看说明书似的.

欢迎光临批处理之家 (http://www.bathome.net/)