• 朱迪:社会发展新阶段的消费品味特征 2019-06-15
  • 淳安县:构建“大调解”体系 2019-06-15
  • 糖尿病打胰岛素是好还是坏?知道答案的糖友都沉默了 2019-06-08
  • 轩辕坛-聚焦汽车两会热点 2019-06-07
  • 波罗木刻:一把刻刀 点木成“金” 2019-06-06
  • 最高检依法决定对余刚立案侦查 2019-06-05
  • 联播快讯:长江镇江段今起实施12天限时封航 2019-06-05
  • 赌王四太家的豪宅曝光,网友:一点都不羡慕 ——凤凰网房产 2019-06-04
  • 回复@海之宁:啥事都要等安排,做好了无所得,做坏了不担责……那不是害人么? 2019-06-03
  • 东京湾产业转型启示录 2019-06-03
  • 索菲亚实控人减持超10亿,财务指标出现神奇“曲线” 2019-06-02
  • 经济专家那么多,谁写出如何搞好公有制呢? 2019-06-02
  • 社区商铺投资,显露复苏迹象 2019-06-01
  • 监督效率高了 办案成本低了 2019-05-31
  • 过年喽!重庆“千米长宴”热闹开席  一眼望不到尽头 2019-05-30
  • 青海网站建设、网络推广最好的公司--您身边的网站建设专家,马上拿起电话,联系我们:0971-8235355   
    4场进球彩方法 4场进球彩方法 |  公司简介 |  网站建设 |  网络推广 |  空间租用 |  域名注册 |  企业邮局 |  网络安全 |  网站编程 |  客服中心 |  联系我们 |  人才招聘
     
    西宁威势最新网站制做案例展示
    Lastest Project
     
    西宁网站建设  
    当前位置为:4场进球彩方法 >> ASP编程 >> 正文  
    利用AspHTTP组件给自己的网站加入Alexa排名数值查询功能

    文章来源: 4场进球彩方法     发布时间:2008-12-15    浏览次数:3194    tags:AspHTTP Alexa

    4场进球彩方法 www.iubwq.tw <%
    '// alexa 世界排名的查询页面为://www.alexa.com/data/details/traffic_details?q=&Url= 4场进球彩方法


    '// 以下函数抓取到含有干扰元素的数据并通过函数对数据进行处理,获得干干净净的Alexa排名数值

    Function alexa(str)

     url="//www.alexa.com/data/details/traffic_details?q=&url="&str
    response.write url
     strs=str
     If IsObjInstalled("AspHTTP.Conn")=true Then
      str= getaspHTTPPage(url)
     else
      str= getHTTPPage(url)
     End if
     if str="" then
      Call Error()
     else
        str_=str
        str1=""
        set reg=new Regexp
      reg.Multiline=True
      reg.Global=True
      reg.IgnoreCase=true
      str_top="<!--Did you know"
      str_bottom="</span>"
      reg.Pattern=""&str_top&"((.|\n)*?)"&str_bottom&""
      Set matches = reg.execute(str_)
      str1=""
      For Each match1 in matches
       str1=str1&match1.Value&"***"
      Next
      Set matches = Nothing
      Set reg = Nothing

      IF str1 <> "" Then
       str1 = Replace(str1,"<!--Did you know? Alexa offers this data programmatically.  Visit //webservices.amazon.com/ for more

    information about the Alexa Web Information Service.-->","")
       str1 = Replace(str1,"</span>","")
       Str_11=split(str1,"<div class=""borderBottom""></div>")
       str1 = Str_11(0)
       Str_11 = split(str1,"***")
       str1_Pan = Str_11(0)
      End If

      set reg=new Regexp
      reg.Multiline=True
      reg.Global=True
      reg.IgnoreCase=true
      str_top="<td class=""traffic"">"
      str_bottom="</td>"
      reg.Pattern=""&str_top&"((.|\n)*?)"&str_bottom&""
      Set matches = reg.execute(str_)
      str1=""
      For Each match1 in matches
       str1=str1&match1.Value&"***"
      Next
      Set matches = Nothing
      Set reg = Nothing

      IF str1 <> "" Then Str_11=split(str1,"***")
     End if

     '************************************
     '************************************
     alexa=getcorrectvalue(str1_Pan)
     '************************************
     '************************************

    End Function

    '************************************
    '此功能函数去除干扰元素
    '************************************
    function getcorrectvalue(source)
    source="|"+source+"|"

    while InStr(source,"<")>0
    thestart = InStr(source, "<")
    theend   = InStr(source, ">")
    source = mid(source,1,thestart-1)+right(source,(len(source)-theend))
    wend

    source=replace(source,"|","")
    source=replace(source,",","")
    getcorrectvalue=source
    end function


    '************************************
    '************************************


    '// <summary>
    '// 采用 Microsoft.XMLHTTP 组件采集数据
    '// </summary>
    Function getHTTPPage(url) 
     on error resume next 
     dim http 
      set http=Server.createobject("Microsoft.XMLHTTP") 
     Http.open "GET",url,false 
     Http.send() 
     if Http.readystate<>4 then
     exit function 
     end if 
     getHTTPPage=bytes2BSTR(Http.responseBody) 
     set http=nothing
     if err.number<>0 then err.Clear  
    End function

    '// <summary>
    '// 采用 ADODB.Stream 处理采集到的数据,把二进制的文件转成文本字符
    '// </summary>
    Function Bytes2bStr(vin)
      Dim BytesStream,StringReturn
      Set BytesStream = Server.CreateObject("ADODB.Stream")
      BytesStream.Type = 2
      BytesStream.Open
      BytesStream.WriteText vin
      BytesStream.Position = 0
      BytesStream.Charset = "GB2312"
      BytesStream.Position = 2
      StringReturn =BytesStream.ReadText
      BytesStream.close
      Set BytesStream = Nothing
      Bytes2bStr = StringReturn
    End Function


    '// <summary>
    '// 采用 AspHTTP.Conn 组件采集数据
    '// </summary>
    Function getaspHTTPPage(url)
      if url="" Then exit function 
     Set HttpObj = Server.CreateObject("AspHTTP.Conn")
     '设置代理服务器,通过代理上网的用户需要设置此选项
     'If ProxyIP=1 Then HttpObj.Proxy="192.168.5.254:808"
     HTTPObj.TimeOut = 45
     HttpObj.Url = url
     HttpObj.RequestMethod = "GET"
     getaspHTTPPage = HttpObj.GetURL
     set HttpObj=nothing
    End function

    '//<summary>
    '//检查组件,采用xmlhttp抓取网页还是AspHTTP
    '//</summary>

    Function IsObjInstalled(strClassString)
     On Error Resume Next
     IsObjInstalled = False
     Err = 0
     Dim xTestObj
     Set xTestObj = Server.CreateObject(strClassString)

     If 0 = Err Then
      If AspHttpOpen=1 Then
      IsObjInstalled = True
      'Response.write "当前组件 ASPHTTP"
      Else
      IsObjInstalled = False
      'Response.write "当前组件 XMLHTTP"
      End If
     Else
     IsObjInstalled = False
     'Response.write "当前组件 XMLHTTP"
     End If

     Set xTestObj = Nothing
     Err = 0

    End Function

    Sub Error()
     response.write "<BR>  抓取不到数据-可能是因为网络原因不能访问站点<BR><a href=javascript:location.reload();>重试</a>"
     response.end
    End Sub


    %> <%=alexa("//www.iubwq.tw")%>


    上一篇:AspHTTP.Conn 详解
    下一篇:ASP小偷程序如何利用XMLHTTP实现表单的提交以及cookies或session的发送
    评论列表
    正在加载评论……
      
    评论   
    呢  称:
    验证码: 若看不清请点击更换!
    内  容:
     
     
      在线洽谈咨询:
    点击这里,在线洽谈   点击这里,在线洽谈   点击这里,在线洽谈
    与我交谈  与我交谈 与我交谈
    乘车路线    汇款方式   加盟合作  人才招聘  
    公司地址:青海省西宁市西关大街73号(三二四部队招行所四楼)     青ICP备13000578号-1 公安机关备案号:63010402000123    
    QQ:147399120    mail:[email protected]    电话: 13897410341    邮编:810000
    © Copyright( 2008-2009) www.iubwq.tw All Rights Reserved    版权所有:西宁威势电子信息服务有限公司 未经书面制授权,请勿随意转载!
    业务:青海网站制做、青海网站建设、青海网页设计、西宁网站制做、西宁网站建设、青海域名注册、青海网络推广、青海网站推广、青??占渥庥?/a>、4场进球彩方法、4场进球彩方法、网络安全

  • 朱迪:社会发展新阶段的消费品味特征 2019-06-15
  • 淳安县:构建“大调解”体系 2019-06-15
  • 糖尿病打胰岛素是好还是坏?知道答案的糖友都沉默了 2019-06-08
  • 轩辕坛-聚焦汽车两会热点 2019-06-07
  • 波罗木刻:一把刻刀 点木成“金” 2019-06-06
  • 最高检依法决定对余刚立案侦查 2019-06-05
  • 联播快讯:长江镇江段今起实施12天限时封航 2019-06-05
  • 赌王四太家的豪宅曝光,网友:一点都不羡慕 ——凤凰网房产 2019-06-04
  • 回复@海之宁:啥事都要等安排,做好了无所得,做坏了不担责……那不是害人么? 2019-06-03
  • 东京湾产业转型启示录 2019-06-03
  • 索菲亚实控人减持超10亿,财务指标出现神奇“曲线” 2019-06-02
  • 经济专家那么多,谁写出如何搞好公有制呢? 2019-06-02
  • 社区商铺投资,显露复苏迹象 2019-06-01
  • 监督效率高了 办案成本低了 2019-05-31
  • 过年喽!重庆“千米长宴”热闹开席  一眼望不到尽头 2019-05-30
  • 火影忍者ol维护 曼联3-1水晶宫 德黑兰独立对阿尔艾因2019 西甲巴伦西亚对韦斯卡 fm2011勒沃库森 梦幻西游2凌波城 赫罗纳大学旅游专业 毕尔巴鄂球衣 中彩网15选5走势图 英超卡迪夫城队