[其他] 批处理采集网站的文章+作者

kabamei

我想采集http://www.juzimi.com/  这个网站的文章+作者。
里面的文章其实就是一句话。
我用火车头采集了，但是效果不理想。 很多页面采集不到。

网站的url规则为http://www.juzimi.com/ju/*****     （http://www.juzimi.com/ju/1399  、http://www.juzimi.com/ju/11  等等）但是里面有很多404页面，这个需要判断下。
如果不是404就可以采集了。

采集的时候能设置页数范围（比如说我想采集200页-1200页的内容）

采集回来所有文章+作者都整理到 一行。 txt输出。

apang

回复 5# kabamei


    好吧，改一改有输出了，去掉了书名号后面的东东

kabamei

回复 3# apang

这个没有输出啊。

hlzj88

只有膜拜了 楼上

apang

Dim xml, fso, i, x, str
Set xml = CreateObject("Microsoft.XMLHTTP")
Set fso = CreateObject("Scripting.Filesystemobject")
For i = 1390 to 1399
    xml.Open "Get", "http://www.juzimi.com/ju/" & i, false
    xml.send()
    x = GetText(xml.responseBody)
    If x <> "" Then str = str & x & vbCrLf
Next
fso.CreateTextFile("Result.txt", true).Write str
Set xml = Nothing : Set fso = Nothing

MsgBox "OK"

Function GetText(s)
    Dim ado
    Set ado = CreateObject("ADODB.Stream")
    ado.Mode = 3
    ado.Type = 1
    ado.Open()
    ado.Write s
    ado.Position = 0 
    ado.Type = 2 
    ado.Charset = "utf-8"
    GetText = RegEx(ado.ReadText)
    Set ado = Nothing
End Function

Function RegEx(s)
    Dim re, m
    Set re = New RegExp
    re.Pattern = "xqaddqrcode\('(.+?)(《[^《]+)?',"
    re.IgnoreCase = true
    For Each m in re.Execute(s)
        RegEx = m.SubMatches(0)
    Next
    Set re = Nothing
End Function
复制代码

hlzj88

说实话 你这个任务我是完成不了，但并不是没有方法，推荐两个帖子
只要下载完这网站的网页，按以下步骤顺序搞定

htox32c /IP /O0 /U1+4 *.html
复制代码

这句代码是html转txt的，来源http://www.bathome.net/thread-7166-1-1.html 涉及的软件也在这里下载

http://www.bathome.net/thread-29885-1-2.html    这个是提取内容的

http://bathome.l3.wuyou.com/thread-29835-1-1.html   这个是合并的

现在返回到开始，下载网页用  网站整站下载器 等一些软件。只要把几个bat组合好，过程就简化成，下载和转换。