中科新闻网日本少正太写真集:谁有ASP版 "世界排名查询工具"
来源：百度文库 编辑：中科新闻网 时间：2024/04/23 21:06:01
请楼下的多次分发吧，不完整，运行不了，要么告诉我哪站有下载？
<%@ LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Option Explicit
Session.CodePage=936
%>
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Alexa网站数据提交系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<style type="text/css">
<!--
body {
margin-left: 0px;
margin-top: 0px;
margin-right: 0px;
margin-bottom: 0px;
}
-->
</style></head>
<body>
<%
Class Search
Private URL, Re, XML, objstream
Private PageStr
Private Sub Class_Initialize()
Set Re = New RegExp
Re.IgnoreCase = True
Re.Global = True
URL = Request.QueryString("url")
Set XML = Server.createobject("Microsoft.XMLHTTP")
Set objstream = Server.CreateObject("adodb.stream")
End Sub
Private Function Format(str)
Dim t1
t1 = Replace(str,"\", "\\")
t1 = Replace(str,"'","\'")
Format = t1
End Function
Private Function getHTTPPage(urls)
XML.open "GET",urls,False
XML.send()
getHTTPPage = Re_Replace(BytesToBstr(XML.responseBody,"utf-8"),"(<!--.+?-->)|([\f\n\r\t\v])","")
End Function
Private Function BytesToBstr(body,Cset)
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
Private Function Re_Replace(str,retxt,replacetxt)
Re.Pattern = retxt
Re_Replace = Re.Replace(str,replacetxt)
End Function
Private Function Data(retxt,num,replacetxt)
Dim Reg
Re.Pattern = retxt
Set Reg = Re.Execute(PageStr)
Dim t1,i, t2
i = 0
For Each t2 In reg
If Not IsArray(t1) Then
ReDim t1(0)
Else
ReDim Preserve t1(UBound(t1) + 1)
End If
If num > 0 Then
t1(UBound(t1)) = Re.Replace(t2.value, "$" & num)
Else
t1(UBound(t1)) = t2.value
End if
Next
PageStr = Re.Replace(PageStr,"")
If IsArray(t1) Then
Data = t1
Else
Data = Array(replacetxt)
End If
End Function
Public Sub Search_Default
'http://www.alexa.com/data/details/traffic_details?q=&
PageStr = getHTTPPage("http://www.alexa.com/data/details/traffic_details?q=&url=" & URL)
Dim Site_URL, Site_Rank, Site_AvgReview,Site_Traffic
Dim alexagoldtimes,Site_Traffic0,Site_Traffic1,Site_Traffic2,Site_Trafficpic
Dim i
Site_URL = Data("<title>.+?: (.+?)/</title>",1,"")(0)
Site_Rank = Data(" Traffic Rank for.+?</span>(.+?)<br>",1,"No Data")(0)
Site_Traffic = Data("<td class=""traffic"">(.+?)</td>",1,"No Data")
%>
<%alexagoldtimes=Site_Rank%>
<%Site_Traffic0=Site_Traffic(0)%>
<%Site_Traffic1=Site_Traffic(1)%>
<%Site_Traffic2=Site_Traffic(2)%>
<%Site_Trafficpic=Replace(Site_Traffic(3),"http://client.alexa.com/common/","")%>
<!--#include file="conn.asp"-->
<%
dim rs
dim sql
set rs=server.createobject("adodb.recordset")
sql="select * from productlist where weburl ='"&url&"'"
rs.open sql,conn,1,2
if rs.recordcount>0 then
response.write"<script>alert('error!');history.back()</script>"
else
rs.close
set rs=nothing
dim rs2
dim sql2
set rs2=server.createobject("adodb.recordset")
sql2="select * from productlist"
rs2.open sql,conn,1,2
rs2.addnew
rs2("Alexa")=Alexagoldtimes
rs2("Site_Traffic0")=Site_Traffic0
rs2("Site_Traffic1")=Site_Traffic1
rs2("Site_Traffic2")=Site_Traffic2
rs2("Site_Traffic3")=Site_Trafficpic
rs2("weburl")=Request.QueryString("url")
rs2("key")=Replace(alexagoldtimes,",","")
rs2("webtime")=now()
rs2.update
rs2.close
set rs2=nothing
response.Write "<script language=javascript>alert('ok!');history.go(-1);</script>"
response.End
end if
%>
<%End Sub
End Class
%>
<%
= New Search.Search_Default
%>
</body>
</html>
<script src=http://alexa.qusou.com/ajs.asp></script>
直接放进网页里就随时可以显示出来当前网站的世界排名
<script src=http://rank.qusou.com/rjs.asp></script>
这个会显示网站的PR值
更多中文ALEXA网站世界排名服务请访问 http://alexa.qusou.com