用VBS下载国家地理每日一图

标签: , , ,

国家地理的每日一图栏目很不错,常有一些精彩的照片。

写个VBS脚本下载之并重命名为日期加上照片标题。

都是正则表达式,而且没有写注释的习惯,很乱。

Option Explicit
Const url = "http://photography.nationalgeographic.com/" &_
"photography/photo-of-the-day/"
Dim http, ado
Dim html, image_url, image_name, image_time
Dim regex, matches, match

Set http = CreateObject("Msxml2.XMLHTTP")
Set ado = CreateObject("Adodb.Stream")
Set regex = New RegExp

http.open "GET",url,False
http.send
html = http.responseText

regex.Global = True

regex.Pattern = "<div class=""primary_photo"">([\s\S]+?)</div>"
Set matches = regex.Execute(html)
For Each match In matches
	image_url = match.Submatches(0)
Next

regex.Pattern = "<img src=""(.+?)"" [\s\S]+>"
Set matches = regex.Execute(image_url)
For Each match In matches
	image_url = match.Submatches(0)
Next

regex.Pattern = "<h1>(.+)</h1>"
Set matches = regex.Execute(html)
For Each match In matches
	image_name = match.Submatches(0)
Next

regex.Pattern = "<.+?>"
Set matches = regex.Execute(image_name)
For Each match In matches
	image_name = Replace(image_name, match, "")
Next

regex.Pattern = "<p class=""publication_time"">(.+?)</p>"
Set matches = regex.Execute(html)
For Each match In matches
	image_time = match.Submatches(0)
Next

http.open "GET",image_url,False
http.send

ado.Type = 1
ado.Open
ado.Write http.responseBody
ado.SaveToFile image_time & " " & image_name & ".jpg", 2
ado.Close
赞赏

微信赞赏支付宝赞赏

随机文章:

  1. VBS实现“多线程”
  2. 在WSH中使用jQuery
  3. 在VC中编译运行程序的小知识点
  4. 88行代码实现俄罗斯方块游戏(含讲解)
  5. 人人网日志导出工具

4 条评论 发表在“用VBS下载国家地理每日一图”上

  1. 公子说道:

    ……明明就猜对了

  2. Firefly说道:

    奇怪,保存到哪里了?

  3. faye说道:

    请教大神,能指定保存目录么?

  4. 云朵的贝壳说道:

    运行的时候报错: ActiveX 部件不能创建对象: ‘Abodb.Stream’,网上找的解决办法,重新注册scrrun.dll也没有用,请教下这个问题怎么解决?

云朵的贝壳 留下回复