<% @LANGUAGE = "VBSCRIPT" codepage= "936"%>
<! DOCTYPE HTML PUBLIC "-//w3c//dtd HTML 4.01 transitional//en" "HTTP://WWW.W3.ORG/TR/HTML4/LOOSE.DTD" >
<meta http-equiv= "Content-type" content= "text/html; charset=gb2312 ">
<title>google PR Value Query procedure </title>
<body><form name= "Form1" method= "Post" action= "Act=ok" >
<p> Input URL
<input type= "text" name= "domain" >
<input type= "Submit" name= "Submission" value= "submitted" >
</p>
</form>
<%
If Trim (request.querystring ("act")) = "OK" then
Domain=trim (Request.Form ("domain"))
If domain<> "" Then
Response.Write ("<b>" &domain& "</b> Google PageRank value is <font color=red>" &GETPR (domain) & "</font>")
End If
End If
Function GETPR (domain)
Getcontent=geturl ("http://so.5eo.com/pr/rank.asp?domain=" &domain)
Getprline=regexptext (GetContent, "obtained in the Google PageRank score of 10 points. * (\d). * cent")
Getpr=regexptext (Getprline, "\s\d\s")
End Function
Function BSTR (vIn)
dim strreturn,i,thischarcode,innercode,hight8,low8,nextcharcode
Strreturn = ""
for i = 1 to LenB (vIn)
thischarcode = AscB (MidB (vin,i,1))
If Thischarcode < &h80 Then
strreturn = strreturn & Chr (thischarcode)
Else
nextcharcode = AscB (MidB (vin,i+1,1))
strreturn = Strreturn & Chr ( CLng (thischarcode) * &h100 + CInt (nextcharcode))
i = i + 1
end If
next
bstr = Strreturn
End Function
Function GetURL (URL)
Set retrieval = Server.CreateObject ("Microsoft.XMLHTTP")
with Retrieval
. Open "Get", url, false
setRequestHeader "Content-type", "application/x-www-form-urlencoded"
. Send
GetURL =. Responsebody
End with
Set retrieval = Nothing
geturl=bstr (GetURL)
End Function
Function Regexptext (STRNG,REGSTR)
' Dim regEx, Match, matches ' creates variables.
Set regEx = New RegExp ' establishes a regular expression.
Regex.pattern = Regstr ' Set mode.
Regex.ignorecase = True ' Sets whether character case is case-sensitive.
Regex.global = True ' Sets global availability.
Set matches = Regex.execute (strng) ' performs a search.
For the match in matches ' traversal matching collection.
Retstr = retstr & Match.value ' & | | | '
Next
Regexptext = Retstr
Set regex=nothing
End Function
%>
</body>
Start building with 50+ products and up to 12 months usage for Elastic Compute Service
1 on 1 presale consultation
24/7 Technical Support 6 Free Tickets per Quarter Faster Response
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.
A comprehensive suite of global cloud computing services to power your business
Payment Methods We Support
