复制代码 代码如下:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<% Response.CodePage=65001%>
<% Response.Charset="UTF-8" %>
<%Server.Scripttimeout=9999999
response.expires = 0
response.expiresabsolute = Now() - 1
response.addHeader "pragma","no-cache"
response.addHeader "cache-control","private"
Response.CacheControl = "no-cache"
%>
<%
'声明取得目标信息的函数,通过XML组件进行实现。
Function GetURL(url)
Set Retrieval = server.createobject("MSXML2.XMLHTTP")
With Retrieval
.Open "GET", url, False
.Send
If .Status<>200 then '判断文档是否已经解析完,以做客户端接受返回消息
exit function
End If
' 二进制转字符串
GetURL = sTb(.responsebody)
end with
'对取得信息进行验证,如果信息长度小于100则说明截取失败
End Function
' 二进制转字符串,否则会出现乱码的!
Function sTb(vin)
Const adTypeText = 2
Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("ADODB.Stream")
With BytesStream
.Type = adTypeText
.Open
.WriteText vin
.Position = 0
.Charset = "GB2312"
.Position = 2
StringReturn = .ReadText
.Close
End With
Set BytesStream = Nothing
sTb = StringReturn
End Function
Function Newstring(Wstr,Strng)
Newstring=Instr(Lcase(Wstr),Lcase(Strng))
If Newstring<=0 Then Newstring=Len(Wstr)
End Function
'声明截取的格式,从Start开始截取,到Over为结束
Function GetKey(HTML,Start,Over)
Start=Newstring(HTML,start)
Over=Newstring(HTML,Over)
GetKey=Mid(HTML,Start,Over-start)
End Function
Dim Softid,Url,Html,Title
'采集百度知道
For i = 1 to 100
Url="http://zhidao.baidu.com/question/10000"&i&".html"
Html = GetURL(Url)
Question = GetKey(Html,"<cq>","</cq>")
Answer = GetKey(Html,"<ca>","</ca>")
内容版权声明:除非注明,否则皆为本站原创文章。