青海龙8国际乐建设、网络推广最好的公司--您身边的龙8国际乐建设专家,马上拿起电话,联系我们:0971-8235355   
青海西宁龙8国际乐建设、龙8国际乐制作公司-西宁威势电子信息服务有限公司
 
西宁威势最新龙8国际乐制做案例展示
Lastest Project
 
当前位置为:首页 >> ASP编程 >> 正文  
龙8国际乐_龙8国际娱乐电脑版_龙8国际娱城手机版

文章来源: 西宁威势电子信息服务有限公司     发布时间:2008-12-15    浏览次数:3293    tags:AspHTTP Alexa

<%
'// alexa 世界排名的查询页面为:http://www.alexa.com/data/details/traffic_details?q=&Url= www.qhwins.com


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

Function alexa(str)

 url="http://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 http://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 = "utf-8"
  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("http://www.qhwins.com")%>


评论列表
正在加载评论……
  
评论   
呢  称:
验证码:
若看不清请点击更换!
内  容:
 
 
  在线洽谈咨询:
点击这里,在线洽谈   点击这里,在线洽谈   点击这里,在线洽谈
乘车路线    汇款方式   加盟合作  人才招聘
 
公司地址:青海省西宁市西关大街73号(三二四部队招行所四楼)     青ICP备13000578号-1 公安机关备案号:63010402000123    
QQ:147399120    mail:lostlove000@163.com    电话: 13897410341    邮编:810000
© Copyright( 2008-2009) QhWins.Com All Rights Reserved    版权所有:西宁威势电子信息服务有限公司 未经书面制授权,请勿随意转载!