asp采集抓取网上房产信息的代码 ASP编程

asp采集抓取网上房产信息的代码

所属类别：ASP编程

一个可以抓取房产信息的asp采集程序[复制此代码]CODE:<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN""http://www.w3.org/TR/html4/loose.dtd">Untitled Document<%on error resume next'Server.ScriptTimeout = 999999'========================================================'字符编码函数'====================================================Function BytesToBstr(body,code)dim objstreamset objstream = Server.CreateObject("adodb.stream")objstream.Type = 1objstream.Mode =3objstream.Openobjstream.Write bodyobjstream.Position = 0objstream.Type = 2objstream.Charset =codeBytesToBstr = objstream.ReadTextobjstream.Closeset 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","")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=""")+6,instr(getcont(i),"""onClick")-10)tempLink=replace(tempLink,"../","")response.Write(i&":"&tempLink&"")NewsContent=ReadXml(tempLink,"gb2312","","")NewsContent=RemoveHtml(NewsContent)NewsContent=replace(NewsContent,VbCrLf,"")NewsContent=replace(NewsContent,vbNewLine,"")NewsContent=replace(NewsContent," ","")NewsContent=replace(NewsContent," ","")NewsContent=replace(NewsContent," ","")NewsContent=replace(NewsContent,"\n","")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.countif(application.Contents(n)=KeyId) thenifexit=trueend ifnextif not ifexit thenapplication(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 MatchesTempStr = Match.ValueTempStr=replace(TempStr,"","")TempStr=replace(TempStr,"","")TempStr=replace(TempStr,"","")TempStr=replace(TempStr,"","")arr(i)=TempStri=i+1if(i>=15) thenexit forend ifNextSet regEx=nothingSet Matches =nothingRemoveTag=arrend functionfunction RegexHtml(body)dim r_arr(47),r_tempSet regEx2 = New RegExpregEx2.Pattern =""regEx2.IgnoreCase = TrueregEx2.Global = TrueSet Matches2 = regEx2.Execute(body)iii=0For Each Match in Matches2r_arr(iii)=Match.Valueiii=iii+1NextRegexHtml=r_arrset regEx2=nothingset Matches2=nothingend function'======================================================conn.closeset conn=nothing%>

....

89411 71730