实例讲解实现抓取网上房产信息的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

 

标签：

相关文章