最近断断续续在网上看小说，小说写全的不多，都看完了。之后陆续看的比较好看的一些小说都在待续的状态中，每天要去几个常看的小说站点看一下是否有更新，很是繁琐，一怒之下，写了一个VB Script脚本，专门去搜索指定的页面，查看是否有更新。放在这里，存档之。
注：如果要运行脚本，需要XML 3.0支持。
'******************************************************************************
' Script Name: checkfav.vbs
'
' V1.0
' Check the special url's content and compare with stored content before
'
' By Fog 2004-09-10
'******************************************************************************
Const C_ORI = 0
Const C_NEW = 1
Dim url(7)
url(0)="http://blog.csdn.net/fogdragon/"
url(0)="http://www.jinyuan.org/"
strShow = url(0)
intReady = ReadyForGet(url(0))
Call GetCurrentPage(url(0))
If intReady = 1 Then
intDiffByte = CompareURL(CreateName( GetURLSite(url(0)), C_New), CreateName( GetURLSite(url(0)), C_ORI))
If intDiffByte = 0 Then
strShow = strShow & " 无更新"
Else
strShow = strShow & intDiffByte
End If
Else
strShow = strShow & " 创建对比页面成功。"
End If
WScript.Echo strShow
' 检查是否有上次获取的记录，如果有，在文件名后加ori，作为备份，将来比较
Function ReadyForGet(DescURL)
Dim strOriName, strNewName, objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
strNewName = CreateName( GetURLSite(DescURL), C_New)
If objFSO.FileExists(strNewName) = True Then
strOriName = CreateName( GetURLSite(DescURL), C_ORI)
objFSO.CopyFile strNewName, strOriName, True
ReadyForGet = 1
Else
ReadyForGet = 0
End If
End Function
' 获得指定URL的页面内容
Function GetCurrentPage(DescURL)
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
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFileName = CreateName( GetURLSite(DescURL), C_NEW )
Set objLogFile = objFSO.CreateTextFile (strFileName, 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)
Select Case intType
Case C_NEW CreateName = strSource & ".htm"
Case C_ORI CreateName = strSource & ".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
