As requested, you guys can download the VB source to collect the Google Pagerank Here: http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=63194&lngWId=1 Their is a .BAS i believe that does the checksum. Then use that checksum in the URL and it will passback a value like var_3_4 and I think the second one is your pagerank... this should work in VB/ASP/.NET (I know it works in .NET cause I'm using in in VB and .NET) Hope this helps
Hi ccoonen, I believe that it would be good if you post the .NET code. VB.NET or C# it doesn't matter but VB6 code is a bit overdated and useless for many people here. Thanks for sharing that with all DF forum members Regards
Add this in a .BAS (its a vb 6 source) Attribute VB_Name = "Mod" Option Explicit Const GOOGLE_MAGIC = &HE6359A60 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 What this does is get the Checksum for the url you are going to check... So, Get the checksum, then hit the url with the checksum Use the WebClient to download the websource ' Get the Checksum Dim CheckSum as string = CalculateChecksum(YourURL) ' Get the PR Source Dim WebObj as New WebClient msgbox(WebObj.DownloadString(http://www.google.com/search?client=navclient-auto&ch=" & CheckSum & "&features=Rank&q=info:" & YourURL It should come out as like pr_4_2 or something like that - you can just MsgBox(Split(Str,"_"),2) to get the PR
well practically this is VB6 code that you use in VB.NET project. I thought you have converted all the code in VB.NET. However, don't you think that Google should offer this functions through their WS's - Google API's ? I think they should. Regards
nice. also there was another thread on google PR written on .NET http://forums.digitalpoint.com/showthread.php?t=298108 I tried it, works.
Been looking all over for this to use in Excel with VBA without success This worked on first try. Amazing!!!! Thanks a lot for sharing this