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

最近断断续续在网上看小说，小说写全的不多，都看完了。之后陆续看的比较好看的一些小说都在待续的状态中，每天要去几个常看的小说站点看一下是否有更新，很是繁琐，一怒之下，写了一个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

本文地址：http://com.8s8s.com/it/it27540.htm