Google PageRank值的研究及VB代码的实现

2005-01-16 , 星期日 , 15:23:13

用Google ToolBar可以获取任意网站的PageRank值，用嗅探工具获得Google ToolBar发出请求的url为：
http://toolbarqueries.google.com//search?client=navclient-auto&ch=XXXXXXXXXXX&ie=UTF-8&oe=UTF-8&features=Rank:FVN&q=info:http%3A//www.abc.com

其中关键部份为ch=XXXXXXXXXXX,即CheckSum

在取得PR值后还要将其转换为0-10的整数型式，查看pr值对照表：

Toolbar PageRank 　Real PageRank 0/10 　　　　　　　　0.15 - 0.9 1/10 　　　　　　　　0.9 - 5.4 2/10　　　　　　　　5.4 - 32.4 3/10 　　　　　　　　32.4 - 194.4 4/10 　　　　　　　　194.4 - 1,166.4 5/10 　　　　　　　　1,166.4 - 6,998.4 6/10 　　　　　　　　6,998.4 - 41,990.4 7/10 　　　　　　　　41,990.4 - 251,942.4 8/10 　　　　　　　　251,942.4 - 1,511,654.4 9/10 　　　　　　　　1,511,654.4 - 9,069,926.4 10/10 　　　　　　　 9,069,926.4 - 0.85 × N + 0.15

下面是VB版本的代码实现（因为我只会VB^_^）

'=========================================================
' functions for the checksum:
'
' Function sl(ByVal x, ByVal n)
' Function sr(ByVal x, ByVal n)
' Function zeroFill(ByVal a, ByVal b)
' Private Function uadd(ByVal L1, ByVal L2)
' Private Function usub(ByVal L1, ByVal L2)
' Function mix(ByVal ia, ByVal ib, ByVal ic)
' Function gc(ByVal s, ByVal i)
' function GoogleCH(ByVal sURL)
' Function CalculateChecksum(sURL)
'=========================================================
Function sl(ByVal x, ByVal n)
    If n = 0 Then
        sl = x
    Else
        Dim k
        k = CLng(2 ^ (32 - n - 1))
        Dim d
        d = x And (k - 1)
        Dim c
        c = d * CLng(2 ^ n)
        If x And k Then
            c = c Or &H80000000
        End If
        sl = c
    End If
End Function

Function sr(ByVal x, ByVal n)
    If n = 0 Then
        sr = x
    Else
        Dim y
        y = x And &H7FFFFFFF
        Dim z
        If n = 32 - 1 Then
            z = 0
        Else
            z = y \ CLng(2 ^ n)
        End If
        If y <> x Then
            z = z Or CLng(2 ^ (32 - n - 1))
        End If
        sr = z
    End If
End Function

Function zeroFill(ByVal a, ByVal b)  
 Dim x
 if (&H80000000 AND a) then 
  x = sr(a,1)
  x = x AND (NOT &H80000000)
  x = x OR &H40000000
        x = sr(x,b-1)
 else
  x = sr(a,b)
 end if
 zeroFill = x
End Function

Private Function uadd(ByVal L1, ByVal L2)
    Dim L11, L12, L21, L22, L31, L32
    L11 = L1 And &HFFFFFF
    L12 = (L1 And &H7F000000) \ &H1000000
    If L1 < 0 Then L12 = L12 Or &H80
    L21 = L2 And &HFFFFFF
    L22 = (L2 And &H7F000000) \ &H1000000
    If L2 < 0 Then L22 = L22 Or &H80
    L32 = L12 + L22
    L31 = L11 + L21
    If (L31 And &H1000000) Then L32 = L32 + 1
    uadd = (L31 And &HFFFFFF) + (L32 And &H7F) * &H1000000
    If L32 And &H80 Then uadd = uadd Or &H80000000
End Function

Private Function usub(ByVal L1, ByVal L2)
    Dim L11, L12, L21, L22, L31, L32
    L11 = L1 And &HFFFFFF
    L12 = (L1 And &H7F000000) \ &H1000000
    If L1 < 0 Then L12 = L12 Or &H80
    L21 = L2 And &HFFFFFF
    L22 = (L2 And &H7F000000) \ &H1000000
    If L2 < 0 Then L22 = L22 Or &H80
    L32 = L12 - L22
    L31 = L11 - L21
    If L31 < 0 Then
        L32 = L32 - 1
        L31 = L31 + &H1000000
    End If
    usub = L31 + (L32 And &H7F) * &H1000000
    If L32 And &H80 Then usub = usub Or &H80000000
End Function
 
Function mix(ByVal ia, ByVal ib, ByVal ic)
 Dim a, b, c
 a = ia
 b = ib
 c = ic
 
 a = usub(a,b)
 a = usub(a,c)
 a = a XOR zeroFill(c,13)
 
 b = usub(b,c)
 b = usub(b,a)
 b = b XOR sl(a,8)
 
 c = usub(c,a)
 c = usub(c,b)
 c = c XOR zeroFill(b,13)
 
 a = usub(a,b)
 a = usub(a,c)
 a = a XOR zeroFill(c,12)
 
 b = usub(b,c)
 b = usub(b,a)
 b = b XOR sl(a,16)
 
 c = usub(c,a)
 c = usub(c,b)
 c = c XOR zeroFill(b,5) 
 
 a = usub(a,b)
 a = usub(a,c)
 a = a XOR zeroFill(c,3)
 
 b = usub(b,c)
 b = usub(b,a)
 b = b XOR sl(a,10)
 
 c = usub(c,a)
 c = usub(c,b)
 c = c XOR zeroFill(b,15)
 
 Dim ret(3)
   
 ret(0) = a
 ret(1) = b
 ret(2) = c
 
 mix = ret
End Function

Function gc(ByVal s, ByVal i)
 gc = Asc(Mid(s,i+1,1))
End Function

function GoogleCH(ByVal sURL)
 Dim iLength, a, b, c, k, iLen, m
 iLength = Len(sURL)

 a = &H9E3779B9
 b = &H9E3779B9
 c = GOOGLE_MAGIC
 k = 0
    
    iLen = iLength
    do while iLen >= 12
        a = uadd(a,(uadd(gc(sURL,k+0),uadd(sl(gc(sURL,k+1),8),uadd(sl(gc(sURL,k+2),16),sl(gc(sURL,k+3),24))))))
        b = uadd(b,(uadd(gc(sURL,k+4),uadd(sl(gc(sURL,k+5),8),uadd(sl(gc(sURL,k+6),16),sl(gc(sURL,k+7),24))))))
        c = uadd(c,(uadd(gc(sURL,k+8),uadd(sl(gc(sURL,k+9),8),uadd(sl(gc(sURL,k+10),16),sl(gc(sURL,k+11),24))))))

  m = mix(a,b,c)
  
        a = m(0)
        b = m(1)
        c = m(2)
        
        k = k + 12

        iLen = iLen - 12
    loop

    c = uadd(c,iLength)

    select case iLen ' all the case statements fall through
        case 11
   c = uadd(c,sl(gc(sURL,k+10),24))
   c = uadd(c,sl(gc(sURL,k+9),16))
   c = uadd(c,sl(gc(sURL,k+8),8))
   b = uadd(b,sl(gc(sURL,k+7),24))
   b = uadd(b,sl(gc(sURL,k+6),16))
   b = uadd(b,sl(gc(sURL,k+5),8))
   b = uadd(b,gc(sURL,k+4))
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 10
   c = uadd(c,sl(gc(sURL,k+9),16))
   c = uadd(c,sl(gc(sURL,k+8),8))
   b = uadd(b,sl(gc(sURL,k+7),24))
   b = uadd(b,sl(gc(sURL,k+6),16))
   b = uadd(b,sl(gc(sURL,k+5),8))
   b = uadd(b,gc(sURL,k+4))
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 9
   c = uadd(c,sl(gc(sURL,k+8),8))
   b = uadd(b,sl(gc(sURL,k+7),24))
   b = uadd(b,sl(gc(sURL,k+6),16))
   b = uadd(b,sl(gc(sURL,k+5),8))
   b = uadd(b,gc(sURL,k+4))
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 8
   b = uadd(b,sl(gc(sURL,k+7),24))
   b = uadd(b,sl(gc(sURL,k+6),16))
   b = uadd(b,sl(gc(sURL,k+5),8))
   b = uadd(b,gc(sURL,k+4))
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 7
   b = uadd(b,sl(gc(sURL,k+6),16))
   b = uadd(b,sl(gc(sURL,k+5),8))
   b = uadd(b,gc(sURL,k+4))
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 6
   b = uadd(b,sl(gc(sURL,k+5),8))
   b = uadd(b,gc(sURL,k+4))
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 5
   b = uadd(b,gc(sURL,k+4))
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 4
   a = uadd(a,sl(gc(sURL,k+3),24))
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 3
   a = uadd(a,sl(gc(sURL,k+2),16))
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 2
   a = uadd(a,sl(gc(sURL,k+1),8))
   a = uadd(a,gc(sURL,k+0))
        case 1
   a = uadd(a,gc(sURL,k+0))
    End Select
    
    m = mix(a,b,c)
    
    GoogleCH = m(2)
End Function

Function CalculateChecksum(sURL)
 CalculateChecksum = "6" & CStr(GoogleCH("info:" & sURL) AND &H7FFFFFFF)
End Function

参看：泰然处之：获取google pagerank值的研究
参看：泰然处之：google pagerank checksum算法
参看：UGiA.CN » 获取Google PageRank值
参看：UGiA.CN » 在你的网页上显示Google PageRank
参看：z4 站长技术交流论坛 - [PHPS] The Google Pagerank Checksum Calculator

david :
我觉得所谓的real pagerank可以估算为：Nd+(1-d)
N是在google搜索到的链接到当前网页的网页数，d是google定义的阻尼值。
比如在google中输入link:www.sohu.com得到的结果是：133,000 项，用上面的公式计算得到113050.15，刚好对应到pr值7，也可以根据各个数据段的百分比算出10以内的pr值小数位
其实这样子很容易的到pr值，根本不用那个checksum加密算法
2005-01-19 , 星期三 , 16:17:25

jflycn :
可以看这里：http://webworkshop.net/pagerank_calculator.php3
2005-01-19 , 星期三 , 16:32:24

rainbowsoft :
这个计算器是如何用的？另外，david你说的方法不一定可行，有的网站的link特少，但它的PR就是高，你如何解释呢？
2005-01-19 , 星期三 , 19:27:42

jfly :
有那样的网站吗？不会吧。PR就是按照链接算出来的。
那个计算器好像也是按照链接算得，没研究，看不太明白:(
你这里可不可以不写E-mail，好累":(-
2005-01-19 , 星期三 , 21:52:05

david :
:(不清楚啊，我只是看了几个，都还符合。
2005-01-20 , 星期四 , 11:54:06

rainbowsoft :
我发现gfans.org就不是的,link数很少的
2005-01-21 , 星期五 , 15:04:15

Google PageRank值的研究及VB代码的实现 :
用Google ToolBar可以获取任意网站的PageRank值，用嗅探工具获得Google ToolBar发出请求的url为：<br />http://toolbarqueries.google.com//search?client=navclient-auto&ch=XXXXXXXXXXX&ie=UTF-8&oe=UTF-8&features=Rank:FVN&q=info:http%3A//www...
2005-02-28 , 星期一 , 18:25:49

大铁锤 :
我找到了GoogleToolbar 3.0.125.1-big版本的Checksum新算法
比原来的2.0.114要简单多了，
http://www.gamesaga.net/有下载，和在线测试(PHP写的）
我过两天将C和PHP的源代码公布出来，希望懂VB的帮忙将它改成asp版本的

http://www.gamesaga.net/pagerank.php这是英文版本

我看到楼上有人说不需要checksum算法，那样你分析链接数目，更麻烦，并且不准
2005-09-15 , 星期四 , 14:48:01

大铁锤 :
不要意思，留的地址不对

http://www.gamesaga.net/
2005-09-15 , 星期四 , 15:04:17

reilen :
Good!Thanks

其实，PageRank只是Google排序的参考之一，作为网站的一种可信度指标！可以这么来理解，只有在影响搜索结果排名的其它因素几乎不起作用的时候，PageRank才会显得特别重要！对于一般页面来说，切合关键词本身更为关键！
2005-11-12 , 星期六 , 00:00:34

[<<] [<] [1] [2] [3] [>] [>>]

布罗格的烘培机

Firefox、Opera、Safari下有的页面会出错，原因是以前的HTML数据不规范所致。

导航栏

2005-01-16 , 星期日 , 15:23:13

Google PageRank值的研究及VB代码的实现

发布:zx.asd | 分类:电脑笔记 | 评论:0 |

Powered by Zdevo 1.0.3125.32067,Template by Nagrand.

Copyright 1999-2005 RainbowSoft Studio. Some Rights Reserved.