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

时间:2022-09-11 22:29:14
  1. <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> 
  2. <!-- #include file="conn.asp" --> 
  3.  
  4. <!-- #include file="inc/function.asp" --> 
  5. <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"
  6. <html> 
  7. <head> 
  8. <title>Untitled Document</title> 
  9. <meta http-equiv="Content-Type" content="text/html; charset=gb2312"
  10. <meta http-equiv="refresh" content="300;URL=steal_house.asp"
  11. </head> 
  12.  
  13. <body> 
  14. <% 
  15. on error resume next 
  16. '  
  17. Server.ScriptTimeout = 999999 
  18. '======================================================== 
  19. '字符编码函数 
  20. '==================================================== 
  21. Function BytesToBstr(body,code)  
  22.         dim objstream  
  23.         set objstream = Server.CreateObject("adodb.stream")  
  24.         objstream.Type = 1  
  25.         objstream.Mode =3  
  26.         objstream.Open  
  27.         objstream.Write body  
  28.         objstream.Position = 0  
  29.         objstream.Type = 2  
  30.         objstream.Charset =code 
  31.         BytesToBstr = objstream.ReadText   
  32.         objstream.Close  
  33.         set objstream = nothing  
  34. End Function 
  35.  
  36. '取行字符串在另一字符串中的出现位置 
  37. Function Newstring(wstr,strng)  
  38.         Newstring=Instr(lcase(wstr),lcase(strng))  
  39.         if Newstring<=0 then Newstring=Len(wstr)  
  40. End Function  
  41. '替换字符串函数 
  42. function ReplaceStr(ori,str1,str2) 
  43. ReplaceStr=replace(ori,str1,str2) 
  44. end function 
  45. '==================================================== 
  46. function ReadXml(url,code,start,ends) 
  47. set oSend=createobject("Microsoft.XMLHTTP"
  48. SourceCode = oSend.open ("GET",url,false)  
  49. oSend.send() 
  50. ReadXml=BytesToBstr(oSend.responseBody,code ) 
  51. start=Instr(ReadXml,start) 
  52. ReadXml=mid(ReadXml,start) 
  53. ends=Instr(ReadXml,ends) 
  54. ReadXml=left(ReadXml,ends-1) 
  55. end function 
  56.  
  57. function SubStr(body,start,ends) 
  58. start=Instr(body,start) 
  59. SubStr=mid(body,start+len(start)+1) 
  60. ends=Instr(SubStr,ends) 
  61. SubStr=left(SubStr,ends-1) 
  62. end function 
  63.  
  64. dim getcont,NewsContent 
  65. dim url,title 
  66. url="http://www.***.com"'新闻网址knowsky.com 
  67. getcont=ReadXml(url,"gb2312","<table class=k2 border=""0""","</table>"
  68. getcont=RegexHtml(getcont) 
  69. dim KeyId,NewsClass,City,Position,HouseType,Level,Area,Price,Demostra 
  70.  
  71. dim ContactMan,Contact 
  72. for i=2 to ubound(getcont) 
  73.  response.Write(getcont(i)&"__<br>"
  74.  
  75.  tempLink=mid(getcont(i),instr(getcont(i),"href=""")+6,instr(getcont(i),""" onClick")-10) 
  76.  tempLink=replace(tempLink,"../",""
  77.  
  78.  response.Write(i&":"&tempLink&"<br>"
  79.  NewsContent=ReadXml(tempLink,"gb2312","<td valign=""bottom"" width=""400"">","<hr width=""760"" noshade size=""1"" color=""#808080""> "
  80.  NewsContent=RemoveHtml(NewsContent) 
  81.  NewsContent=replace(NewsContent,VbCrLf,""
  82.  NewsContent=replace(NewsContent,vbNewLine,""
  83.  NewsContent=replace(NewsContent," ",""
  84.  NewsContent=replace(NewsContent," ",""
  85.  NewsContent=replace(NewsContent," ","")  
  86.  NewsContent=replace(NewsContent,"\n","")  
  87.  NewsContent=replace(NewsContent,chr(10),""
  88.  NewsContent=replace(NewsContent,chr(13),""
  89.  '===============get Content======================= 
  90.  response.Write(NewsContent) 
  91.  KeyId=SubStr(NewsContent,"列号:","信息类别:"
  92.  NewsClass=SubStr(NewsContent,"类别:","所在城市:"
  93.  City=SubStr(NewsContent,"城市:","房屋具体位置:"
  94.  Position=SubStr(NewsContent,"位置:","房屋类型:"
  95.  HouseType=SubStr(NewsContent,"类型:","楼层:"
  96.  Level=SubStr(NewsContent,"楼层:","使用面积:"
  97.  Area=SubStr(NewsContent,"面积:","房价:"
  98.  Price=SubStr(NewsContent,"房价:","其他说明:"
  99.  Demostra=SubStr(NewsContent,"说明:","联系人:"
  100.  ContactMan=SubStr(NewsContent,"联系人:","联系方式:"
  101.  Contact=SubStr(NewsContent,"联系方式:","信息来源:")  
  102.  response.Write("总序列号:"&KeyId&"<br>"
  103.  response.Write("信息类别:"&NewsClass&"<br>"
  104.  response.Write("所在城市:"&City&"<br>"
  105.  response.Write("房屋具体位置:"&Position&"<br>"
  106.  response.Write("房屋类型:"&HouseType&"<br>"
  107.  response.Write("楼层:"&Level&"<br>"
  108.  response.Write("使用面积:"&Area&"<br>"
  109.  response.Write("房价:"&Price&"<br>"
  110.  response.Write("其他说明:"&Demostra&"<br>"
  111.  response.Write("联系人:"&ContactMan&"<br>"
  112.  response.Write("联系方式:"&Contact&"<br>"
  113.  'title=RemoveHTML(aa(i)) 
  114.  'response.Write("title:"&title) 
  115.  for n=0 to application.Contents.count 
  116.    if(application.Contents(n)=KeyId) then 
  117.     ifexit=true      
  118.    end if    
  119.  next   
  120.  if not ifexit then 
  121.    application(time&i)=KeyId 
  122.  '添加到数据库 
  123.  '==================================================== 
  124.  set rs=server.CreateObject("adodb.recordset")  
  125.  rs.open "select top 1 * from news order by id desc",conn,3,3 
  126.  rs.addnew 
  127.  rs("NewsClass")=NewsClass 
  128.  rs("City")=City 
  129.  rs("Position")=Position 
  130.  rs("HouseType")=HouseType 
  131.  rs("Level")=Level 
  132.  rs("Area")=Area 
  133.  rs("Price")=Price 
  134.  rs("Demostra")=Demostra 
  135.  rs("ContactMan")=ContactMan 
  136.  rs("Contact")=Contact 
  137.  rs.update 
  138.  rs.close 
  139.  set rs=nothing 
  140.  end if 
  141.  '================================================== 
  142.  
  143. next 
  144. function RemoveTag(body) 
  145.  
  146.  Set regEx = New RegExp 
  147.  regEx.Pattern = "<[a].*?<\/[a]>" 
  148.  regEx.IgnoreCase = True 
  149.  regEx.Global = True 
  150.  Set Matches = regEx.Execute(body)  
  151.  dim i,arr(15),ifexit 
  152.  i=0 
  153.  j=0 
  154.  For Each Match in Matches 
  155.   TempStr = Match.Value   
  156.   TempStr=replace(TempStr,"<td>",""
  157.   TempStr=replace(TempStr,"</td>",""
  158.   TempStr=replace(TempStr,"<tr>",""
  159.   TempStr=replace(TempStr,"</tr>","")   
  160.   arr(i)=TempStr   
  161.   i=i+1 
  162.   if(i>=15) then 
  163.    exit for 
  164.   end if 
  165.  Next 
  166.  Set regEx=nothing 
  167.  Set Matches =nothing 
  168.  RemoveTag=arr 
  169.  
  170. end function 
  171. function RegexHtml(body) 
  172.  dim r_arr(47),r_temp 
  173.  Set regEx2 = New RegExp 
  174.  regEx2.Pattern ="<a.*?<\/a>" 
  175.  regEx2.IgnoreCase = True 
  176.  regEx2.Global = True 
  177.  Set Matches2 = regEx2.Execute(body)  
  178.  iii=0  
  179.  For Each Match in Matches2 
  180.  
  181.   r_arr(iii)=Match.Value 
  182.  
  183.   iii=iii+1   
  184.  Next 
  185.  RegexHtml=r_arr 
  186.  set regEx2=nothing 
  187.  set Matches2=nothing 
  188. end function 
  189. '====================================================== 
  190.  
  191. conn.close 
  192. set conn=nothing 
  193. %> 
  194. </body> 
  195. </html> 

  function.asp

  1.  <% 
  2. '************************************************** 
  3. '函数名:gotTopic 
  4. '作  用:截字符串,汉字一个算两个字符,英文算一个字符 
  5. '参  数:str   ----原字符串 
  6. '       strlen ----截取长度 
  7. '返回值:截取后的字符串 
  8. '************************************************** 
  9. function gotTopic(str,strlen) 
  10.  if str="" then 
  11.   gotTopic="" 
  12.   exit function 
  13.  end if 
  14.  dim l,t,c, i 
  15.  str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<") 
  16.  str=replace(str,"?",""
  17.  l=len(str) 
  18.  t=0 
  19.  for i=1 to l 
  20.   c=Abs(Asc(Mid(str,i,1))) 
  21.   if c>255 then 
  22.    t=t+2 
  23.   else 
  24.    t=t+1 
  25.   end if 
  26.   if t>=strlen then 
  27.    gotTopic=left(str,i) & "…" 
  28.    exit for 
  29.   else 
  30.    gotTopic=str 
  31.   end if 
  32.  next 
  33.  gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<") 
  34. end function 
  35. '========================================================= 
  36. '函数:RemoveHTML(strHTML) 
  37. '功能:去除HTML标记 
  38. '参数:strHTML  --要去除HTML标记的字符串 
  39. '========================================================= 
  40. Function RemoveHTML(strHTML)  
  41. Dim objRegExp, Match, Matches  
  42. Set objRegExp = New Regexp 
  43.  
  44. objRegExp.IgnoreCase = True  
  45. objRegExp.Global = True  
  46. '取闭合的<>  
  47. objRegExp.Pattern = "<.+?>"  
  48. '进行匹配  
  49. Set Matches = objRegExp.Execute(strHTML) 
  50.  
  51. ' 遍历匹配集合,并替换掉匹配的项目  
  52. For Each Match in Matches  
  53. strHtml=Replace(strHTML,Match.Value,"")  
  54. Next  
  55. RemoveHTML=strHTML  
  56. Set objRegExp = Nothing  
  57. set Matches=nothing 
  58. End Function 
  59.  
  60. %> 

  conn.asp

  1.  <% 
  2. 'on error resume next 
  3. set conn=server.CreateObject("adodb.connection")  
  4. con= "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("stest.mdb")  
  5. conn.open con 
  6.  
  7. sub connclose  
  8.    conn.close 
  9.    set conn=nothing    
  10. end sub 
  11. %> 


 


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

 

总序列号:

479280  

信息类别:

出租

所在城市:

济南

房屋具体位置:

华龙路华信路交界口

房屋类型:

其他

楼层:

六层

使用面积:

24~240 平方米之间

房价:

0  [租赁:元/月,买卖:万元/套]

其他说明:

华信商务楼3至6层小空间对外出租(0.5元/平起),本楼属纯商务办公投资使用,可用于办公写字间,周边设施齐全、交通便利(37、80、K95在本楼前经过),全产权、市证,楼内设施包括水、电、暖、电梯设施齐全,有意者可电讯!

联系人:

鲁、王

联系方式:

88017966、86812217

信息来源:

2005-8-4 8:28:55  来自:218.98.86.175

点击次数:

19