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

最新推荐文章于 2024-09-11 16:48:28 发布

技术人生黄勇

最新推荐文章于 2024-09-11 16:48:28 发布

阅读量2.2k

点赞数

分类专栏： NOTE 文章标签：脚本 function microsoft url byte documentation

本文链接：https://blog.csdn.net/fogdragon/article/details/100697

版权

NOTE 专栏收录该内容

9 篇文章 0 订阅

订阅专栏

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