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

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

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
复制代码