[采集的优点]QQ-35岁前要培养的66种思维-采集

前些天在网上看到QQ上有一篇“35岁前要培养的66种思维”的文章，想放到手机里看，以前的方法是，把每一个页面都保存下来然后再处理，或打开Emeditor一个一个的复制上去，这样算下来这个55篇文章得认认真真的copy 55次，实在是太累了，因为本人比较懒，所以喜欢找简单的方法，

前些天学过的正则及采集想都不带想的就从脑子里蹦出来了，好，就用采集及FSO实现，先分析了一下他的结构，感觉真是太简单了，连查看源代码都不带查的，是有规律的数字组成的链接。想看看究竟的可以上去仔细看看，我是不用看了。

采集的过程是：根据规律生成数字链接－－》然后对每页进行分析找出内容、及标题区域，用正则进行匹配并取出－－》然后用FSO保存.

别的什么把这些文件组成一个文件，或组成一个txt文件，自己想办法喽，很简单的。（提醒一下，可以用cmd的,type 1.html >>allhtml.html,如果要保存成txt的，可以把allhtml.html打开，然后全选copy到记事本里就行了。）

下边给出采集代码，不会的别找我，很没有技术含量的，不过很经典，采集可以提高工作效率的。保存成“QQ.wsf”

原创作者：柳永法(yongfa365)'Blog

<job id="QQ-35岁前要培养的66种思维-柳永法(yongfa365)'Blog采集的方法">
<script language="vbs">
re_content = "(<div id=""content""[\s\S]+?</div>)"'内容正则
re_title = "(<title>[^ ]*</title>)"'标题正则

For idx = 1 To 55
    url = "http://book.qq.com/s/book/0/5/5245/"& idx &".shtml"'要采集的网站的地址
    Body = getHTTPPage(url)'得到网站内容
    txtContent=RegExpTest(re_title, Body)  & RegExpTest(re_content, Body)'取出网站的标题与内容
 call CreateFile( idx &".html",txtContent)'生成文件
next
msgbox("成功")

'----------------------------------------函数区-----------------------------------------------------

Function RegExpTest(patrn, strng)
    Dim regEx, Match, Matches '建立变量。
    Set regEx = New RegExp '建立正则表达式。
    regEx.Pattern = patrn'设置模式。
    regEx.IgnoreCase = True '设置是否区分字符大小写。
    regEx.Global = True '设置全局可用性。
    Set Matches = regEx.Execute(strng)'执行搜索。
    For Each Match in Matches'遍历匹配集合。
        RetStr = RetStr & "|" & Match.SubMatches(0)
    Next
    RegExpTest = RetStr
End Function

Function getHTTPPage(Path)
    t = GetBody(Path)
    getHTTPPage = BytesToBstr(t, "GB2312")
End Function

Function GetBody(url)
    On Error Resume Next
    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    With xmlhttp
        .Open "Get", url, False, "", ""
        .Send
        If xmlhttp.Status<>200 Then Exit Function
        GetBody = .ResponseBody
    End With
    Set xmlhttp = Nothing
End Function

Function BytesToBstr(Body, Cset)
    On Error Resume Next
    Dim objstream
    Set objstream = CreateObject("adodb.stream")
    objstream.Type = 1
    objstream.Mode = 3
    objstream.Open
    objstream.Write Body
    objstream.Position = 0
    objstream.Type = 2
    objstream.Charset = Cset
    BytesToBstr = objstream.ReadText
    objstream.Close
    Set objstream = Nothing
End Function

Function CreateFile(FileName, Content)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fd = FSO.CreateTextFile(FileName, True)
    fd.WriteLine Content
End Function

</script>
</job>