本帖最后由 apang 于 2014-5-8 21:15 编辑
- 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
复制代码
|