查看指定网站页面是否有更新的脚本工具

版权声明:可以任意转载,转载时请务必以超链接形式标明文章和作者信息。

最近断断续续在网上看小说,小说写全的不多,都看完了。之后陆续看的比较好看的一些小说都在待续的状态中,每天要去几个常看的小说站点看一下是否有更新,很是繁琐,一怒之下,写了一个VB Script脚本,专门去搜索指定的页面,查看是否有更新。放在这里,存档之。

注:

1.如果要运行脚本,需要XML 3.0支持,因为用到了XMLHTTP对象。XML下载地址:Microsoft XML Parser 3.0 SP 4

2.从XMLHTTP对象返回的ResponseBody是二进制的数据,中文无法直接读取,需要通过转换。在VB环境下,直接用StrConv函数就可以完成。这里改用了别的方式实现:调用ADO.Strem类,设定字符集类型Charset ,写入流,然后再按指定类型字符读出。

3.一般中文页面会用两种方式的Charset:GB2312或者UTF-8。比如CSDN就用的后者,在对字符流转换时,还需要调用getResponseHeader,从HTTP头里面获得编码信息。一般UTF-8会明确指定,GB2312则是默认。

'*******************************************************
' Script Name: checkfav.vbs
' Writer???? : Fog
'
' Check the special url's content
' and compare with stored content before
'
' V1.1?? 2004-09-13
' 1. 产生的镜像文件不再只包含站点名,而是给定URL的全路径,
'??? 避免同一站点多个不同路径下文件产生相同镜像。
'
' V1.0?? 2004-09-10
' 1. 读取指定URL地址的页面,并在本地产生镜像文件。
' 2. 支持指定多个URL地址,循环读取URL地址数组。
' 3. 增加读取HTTP返回头,获得对字符集判断(GB/UTF-8)。
'
'********************************************************
Const C_ORI = 0
Const C_NEW = 1

Dim? url(7), i
url(0)="
http://blog.csdn.net/fogdragon/"
url(1)="
http://www.jinyuan.org/"
url(2)="
http://read.hjsm.net/book/4216/html/contents.html"
url(3)="
http://read.hjsm.net/book/574/html/contents.html"
url(4)="
http://read.hjsm.net/book/505/html/contents.html"
url(5)="
http://read.hjsm.net/book/298/html/contents.html"
url(6)="
http://read.hjsm.net/book/7033/html/contents.html"

For i=0 to UBound(url)
? If Len(url(i)) > 0 Then
??strNewName = CreateName( url(i), C_New)
??strOriName = CreateName( url(i), C_ORI)

??intReady = ReadyForGet(url(i), strNewName, strOriName)
??strTitle = GetCurrentPage(url(i), strNewName)
??strShow = strTitle & " (" & url(i) & ")"
??WScript.Echo strShow

??If intReady = 1 Then
??? intDiffByte = CompareURL(strNewName, strOriName)
???strShow = "update:" & intDiffByte & "byte"
??Else
??? strShow = "create origin mirror success。"
??End If
??
??WScript.Echo strShow
??WScript.Echo ""
?End if
Next

' 检查是否有上次获取的记录,如果有,在文件名后加ori,作为备份,将来比较
Function ReadyForGet(DescURL, NewName, OriName)
Dim strOriName, strNewName, objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(NewName) = True Then
? objFSO.CopyFile NewName, OriName, True
? ReadyForGet = 1
Else
? ReadyForGet = 0
End If
End Function

' 获得指定URL的页面内容
Function GetCurrentPage(DescURL, NewName)
Dim objHTTP, strCodebase, objFSO, strFileName, objLogFile
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Call objHTTP.Open("GET", DescURL, FALSE)
objHTTP.Send
strCodebase = GetCodeBase(objHTTP.getResponseHeader("Content-Type"))
strIndex=BytesToBstr(objHTTP.ResponseBody, strCodebase)
Set objHTTP = Nothing
GetCurrentPage = GetBlock(LCase(strIndex), "")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.CreateTextFile (NewName, True)
objLogFile.Write strIndex
objLogFile.Close
Set objFSO=Nothing
End Function

Function CompareURL(NewName, OriName)
Dim objFSO, fNew, fOri
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set fNew = objFSO.GetFile(NewName)
Set fOri = objFSO.GetFile(OriName)
CompareURL = fNew.Size - fOri.Size
End Function

'使用Adodb.Stream处理二进制数据
Function BytesToBstr(strBody,CodeBase)
Dim objStream
set objStream = CreateObject("Adodb.Stream")
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write strBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CodeBase
BytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
End Function

' 从完整的URL地址取得出网站域名
Function GetURLSite(strURL)
GetURLSite = GetBlock(strURL, "http://", Chr(47))
End Function

' 取得HTTP返回值中的字符集标识
Function GetCodeBase(StrHead)
GetCodeBase = GetBlock(StrHead, "charset=", "")
If Len(GetCodeBase) = 0 Then GetCodeBase = "GB2312"
End Function

' 创建文件名
Function CreateName(strSource, intType)
Dim s
s = strSource
s = Replace(Replace(s, "http://", ""), "/", ".")

Select Case intType
Case C_NEW CreateName = s & ".htm"
Case C_ORI CreateName = s & ".ori.htm"
End Select
End Function

' 获得两个指定特征字符串中间的字符
Function GetBlock(strsource, strdesstart, strdesend)
??? Dim istart, iend, s
??? istart = InStr(strsource, strdesstart)
??? If istart = 0 Then
??? ?GetBlock = ""
??? Else
??????? If Len(strdesend) > 0 Then
??????? ?iend = InStr(istart + Len(strdesstart), strsource, strdesend)
??????? ?istart = istart + Len(strdesstart)
??????? ?GetBlock = Mid(strsource, istart, iend - istart)
??????? Else
????????? GetBlock = Right(strsource, Len(strsource) - istart - Len(strdesstart) + 1)
??????? End If
??? End If
End Function

 

测试运行输出结果:

D:/work/checkfav>checkfav.vbs
Microsoft (R) Windows Script Host Version 5.6
版权所有(C) Microsoft Corporation 1996-2001。保留所有权利。

龙骑将 (http://blog.csdn.net/fogdragon/)
update:1097byte

新华联锦园 - 业主的网上家园 (http://www.jinyuan.org/)
update:219byte

《中华仙魔录》 -- 龙鳞道 -- 幻剑书盟 (http://read.hjsm.net/book/4216/html/conten
ts.html)
update:0byte

小兵传奇 -- 玄雨 -- 幻剑书盟 (http://read.hjsm.net/book/574/html/contents.html)
update:0byte

诛仙 -- 萧鼎 -- 幻剑书盟 (http://read.hjsm.net/book/505/html/contents.html)
update:0byte

佣兵天下 -- 说不得大师 -- 幻剑书盟 (http://read.hjsm.net/book/298/html/contents.
html)
update:0byte

大魔导师的复仇 -- 读书之人 -- 幻剑书盟 (http://read.hjsm.net/book/7033/html/cont
ents.html)
update:0byte

 

?

参考资料:

MSXML 4.0 SDK Documentation

Microsoft XML Parser 3.0 SP4 SDK

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值