捉蜘蛛的ASP代码

[复制链接]
查看: 991   回复: 0
发表于 2008-1-2 16:09:47 | 显示全部楼层 |阅读模式
捉蜘蛛的ASP代码,昨天很多人问,现在我放出了,不过其实落伍早就有了,只不会没说清楚用法。压缩文件里有使用说明,希望对大家有用。
PS:你捉到蜘蛛,但它不一定从你(不一定会收录),还有,蜘蛛爬过后,robots文件夹下会生成对蜘蛛名的文本文件
  1. <%
  2. Sub robot()
  3.         Dim robots:robots="Baiduspider+@Baidu|Googlebot@Google|ia_archiver@Alexa|IAArchiver@Alexa|ASPSeek@ASPSeek|YahooSeeker@Yahoo|SogouBot@sogou|help.yahoo.com/help/us/ysearch/slurp@Yahoo|sohu-search@SOHU|MSNBOT@MSN"
  4.         dim I1,I2,l1,l2,l3,i,rs
  5.         l2=false
  6.         l1=request.servervariables("http_user_agent")
  7.         F1=request.ServerVariables("SCRIPT_NAME")
  8.         I1=split(robots,chr(124))
  9.         for i=0 to ubound(I1)
  10.                 I2=split(I1(i),"@")
  11.                 if instr(lcase(l1),lcase(I2(0)))>0 then
  12.                         l2=true:l3=I2(1):exit for
  13.                 end if
  14.         next
  15.         if l2 and len(l3)>0 then'如果是爬虫,就更新爬虫信息
  16.                 FilePath = Server.Mappath("robots/"&l3&"_robots.txt")
  17.                 '记录蜘蛛爬行
  18.                 Set Fso = Server.CreateObject("Scripting.FileSystemObject")
  19.                 Set Fout = Fso.OpenTextFile(FilePath,8,True)
  20.                                 Fout.WriteLine "索引页面:"&F1
  21.                                 Fout.WriteLine "蜘蛛:"&l3&chr(32)&chr(32)&"更新时间:"&Now()
  22.                                 Fout.WriteLine "-----------------------------------------------"
  23.                                 Fout.Close
  24.                 Set Fout = Nothing
  25.                 Set Fso = Nothing
  26.         end if
  27. end Sub
  28. %>0 then
  29.                         l2=true:l3=I2(1):exit for
  30.                 end if
  31.         next
  32.         if l2 and len(l3)>0 then'如果是爬虫,就更新爬虫信息
  33.                 FilePath = Server.Mappath("robots/"&l3&"_robots.txt")
  34.                 '记录蜘蛛爬行
  35.                 Set Fso = Server.CreateObject("Scripting.FileSystemObject")
  36.                 Set Fout = Fso.OpenTextFile(FilePath,8,True)
  37.                                 Fout.WriteLine "索引页面:"&F1
  38.                                 Fout.WriteLine "蜘蛛:"&l3&chr(32)&chr(32)&"更新时间:"&Now()
  39.                                 Fout.WriteLine "-----------------------------------------------"
  40.                                 Fout.Close
  41.                 Set Fout = Nothing
  42.                 Set Fso = Nothing
  43.         end if
  44. end Sub
  45. %>
复制代码
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则