当前位置: 王朝网络 >> asp >> 实例讲解ASP实现抓取网上房产信息

实例讲解ASP实现抓取网上房产信息

王朝asp·作者佚名 2008-05-21

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"><html><head><title>Untitled Document</title><meta http-equiv="Content-Type" content="text/html; charset=gb2312"><meta http-equiv="refresh" content="300;URL=steal_house.asp"></head><body><%on error resume next'Server.ScriptTimeout = 999999'========================================================'字符编码函数'====================================================Function BytesToBstr(body,code)

dim objstream

set objstream = Server.CreateObject("adodb.stream")

objstream.Type = 1

objstream.Mode =3

objstream.Open

objstream.Write body

objstream.Position = 0

objstream.Type = 2

objstream.Charset =code

BytesToBstr = objstream.ReadText

objstream.Close

set objstream = nothingEnd Function'取行字符串在另一字符串中的出现位置Function Newstring(wstr,strng)

Newstring=Instr(lcase(wstr),lcase(strng))

if Newstring<=0 then Newstring=Len(wstr)End Function'替换字符串函数function ReplaceStr(ori,str1,str2)ReplaceStr=replace(ori,str1,str2)end function'====================================================function ReadXml(url,code,start,ends)set oSend=createobject("Microsoft.XMLHTTP")SourceCode = oSend.open ("GET",url,false)oSend.send()ReadXml=BytesToBstr(oSend.responseBody,code )start=Instr(ReadXml,start)ReadXml=mid(ReadXml,start)ends=Instr(ReadXml,ends)ReadXml=left(ReadXml,ends-1)end functionfunction SubStr(body,start,ends)start=Instr(body,start)SubStr=mid(body,start+len(start)+1)ends=Instr(SubStr,ends)SubStr=left(SubStr,ends-1)end functiondim getcont,NewsContentdim url,titleurl="http://www.***.com"'新闻网址getcont=ReadXml(url,"gb2312","<table class=k2 border=""0""","</table>")getcont=RegexHtml(getcont)dim KeyId,NewsClass,City,Position,HouseType,Level,Area,Price,Demostradim ContactMan,Contactfor i=2 to ubound(getcont)response.Write(getcont(i)&"__ ")tempLink=mid(getcont(i),instr(getcont(i),"href="" mce_href=""")+6,instr(getcont(i),""" onClick")-10)tempLink=replace(tempLink,"../","")response.Write(i&":"&tempLink&" ")NewsContent=ReadXml(tempLink,"gb2312","<td valign=""bottom"" width=""400"">","<hr width=""760"" noshade size=""1"" color=""#808080""> ")NewsContent=RemoveHtml(NewsContent)NewsContent=replace(NewsContent,VbCrLf,"")NewsContent=replace(NewsContent,vbNewLine,"")NewsContent=replace(NewsContent,"","")NewsContent=replace(NewsContent," ","")NewsContent=replace(NewsContent," ","")NewsContent=replace(NewsContent,"

","")NewsContent=replace(NewsContent,chr(10),"")NewsContent=replace(NewsContent,chr(13),"")'===============get Content=======================response.Write(NewsContent)KeyId=SubStr(NewsContent,"列号：","信息类别：")NewsClass=SubStr(NewsContent,"类别：","所在城市：")City=SubStr(NewsContent,"城市：","房屋具体位置：")Position=SubStr(NewsContent,"位置：","房屋类型：")HouseType=SubStr(NewsContent,"类型：","楼层：")Level=SubStr(NewsContent,"楼层：","使用面积：")Area=SubStr(NewsContent,"面积：","房价：")Price=SubStr(NewsContent,"房价：","其他说明：")Demostra=SubStr(NewsContent,"说明：","联系人：")ContactMan=SubStr(NewsContent,"联系人：","联系方式：")Contact=SubStr(NewsContent,"联系方式：","信息来源：")response.Write("总序列号:"&KeyId&" ")response.Write("信息类别:"&NewsClass&" ")response.Write("所在城市:"&City&" ")response.Write("房屋具体位置:"&Position&" ")response.Write("房屋类型:"&HouseType&" ")response.Write("楼层:"&Level&" ")response.Write("使用面积:"&Area&" ")response.Write("房价:"&Price&" ")response.Write("其他说明:"&Demostra&" ")response.Write("联系人:"&ContactMan&" ")response.Write("联系方式:"&Contact&" ")'title=RemoveHTML(aa(i))'response.Write("title:"&title)for n=0 to application.Contents.count

if(application.Contents(n)=KeyId) then

ifexit=true

end if

if not ifexit then

application(time&i)=KeyId'添加到数据库'====================================================set rs=server.CreateObject("adodb.recordset")rs.open "select top 1 * from news order by id desc",conn,3,3rs.addnewrs("NewsClass")=NewsClassrs("City")=Cityrs("Position")=Positionrs("HouseType")=HouseTypers("Level")=Levelrs("Area")=Arears("Price")=Pricers("Demostra")=Demostrars("ContactMan")=ContactManrs("Contact")=Contactrs.updaters.closeset rs=nothingend if'==================================================nextfunction RemoveTag(body)Set regEx = New RegExpregEx.Pattern = "<[a].*?</[a]>"regEx.IgnoreCase = TrueregEx.Global = TrueSet Matches = regEx.Execute(body)dim i,arr(15),ifexiti=0j=0For Each Match in Matches

TempStr = Match.Value

TempStr=replace(TempStr,"<td>","")

TempStr=replace(TempStr,"</td>","")

TempStr=replace(TempStr,"<tr>","")

TempStr=replace(TempStr,"</tr>","")

arr(i)=TempStr

i=i+1

if(i>=15) then

exit for

end ifNextSet regEx=nothingSet Matches =nothingRemoveTag=arrend functionfunction RegexHtml(body)dim r_arr(47),r_tempSet regEx2 = New RegExpregEx2.Pattern ="<a.*?</a>"regEx2.IgnoreCase = TrueregEx2.Global = TrueSet Matches2 = regEx2.Execute(body)iii=0For Each Match in Matches2

r_arr(iii)=Match.Value

iii=iii+1

NextRegexHtml=r_arrset regEx2=nothingset Matches2=nothingend function'======================================================conn.closeset conn=nothing%></body></html>

function.asp<%'**************************************************'函数名：gotTopic'作

用：截字符串，汉字一个算两个字符，英文算一个字符'参

数：str

----原字符串'

strlen ----截取长度'返回值：截取后的字符串'**************************************************function gotTopic(str,strlen)if str="" then

gotTopic=""

exit functionend ifdim l,t,c, istr=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")str=replace(str,"?","")l=len(str)t=0for i=1 to l

c=Abs(Asc(Mid(str,i,1)))

if c>255 then

t=t+2

else

t=t+1

end if

if t>=strlen then

gotTopic=left(str,i) & "…"

exit for

else

gotTopic=str

end ifnextgotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")end function'========================================================='函数：RemoveHTML(strHTML)'功能：去除HTML标记'参数：strHTML

--要去除HTML标记的字符串'=========================================================Function RemoveHTML(strHTML)Dim objRegExp, Match, MatchesSet objRegExp = New RegexpobjRegExp.IgnoreCase = TrueobjRegExp.Global = True'取闭合的<>objRegExp.Pattern = "<.+?>"'进行匹配Set Matches = objRegExp.Execute(strHTML)' 遍历匹配集合，并替换掉匹配的项目For Each Match in MatchesstrHtml=Replace(strHTML,Match.Value,"")NextRemoveHTML=strHTMLSet objRegExp = Nothingset Matches=nothingEnd Function%>

conn.asp<%'on error resume nextset conn=server.CreateObject("adodb.connection")con= "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("stest.mdb")conn.open consub connclose

conn.close

set conn=nothing

end sub%>

附：抓取信息的详细页面事例

总序列号：

479280

信息类别：

出租

所在城市：

济南

房屋具体位置：

华龙路华信路交界口