Google PR Script

Remember to download from: http://www.aaronreynolds.co.uk/blogs/20070720203640.html for the version that works with folders and complex URLs.

 

Thanks buddy, I will check it out.
If you are interested we can work together develop a set of tools (asp .net), and share.
I have a bookmarking tool built already.

 

sounds like a plan, but when I have more time lol

 

So I took Aaron's code and converted it to VB.net. The project I started was in vb so I want to keep it that way but I am stuck on one little problem, anyone care to give it a try, here is the code, then I will explain the problem.

------------------------------------------------------------------------
Imports System
Imports System.Text
Imports System.IO
Imports System.Net
Imports System.Data
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Partial Class TestCrawl
Inherits System.Web.UI.Page
Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs)

End Sub
Private _GooglePR_URL As String = "http://toolbarqueries.google.com/search?client=navclient-auto&ie=UTF-8&oe=UTF-8&features=Rank:&q=info:"
Protected Sub btnGo_Click1(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnGo.Click
Dim _SiteURL As String = txtSiteURL.Text
Dim _HashedURL As String = CheckHash(GetHash(_SiteURL))

Dim _LURL As String = Server.UrlEncode(_SiteURL).Replace(".", "%2e")
_GooglePR_URL += _LURL + "&ch=" + _HashedURL

' Open a GET
'Response.Write(_GooglePR_URL)

Dim _Response As String = GetResponse(_GooglePR_URL)
Dim _PageRank As String = Nothing

If _Response IsNot Nothing Then
Dim _Parts As String() = _Response.Split(":".ToCharArray(), 3, StringSplitOptions.RemoveEmptyEntries)
Try
_PageRank = _Parts(2)
Catch
_PageRank = Nothing
End Try
End If
If _PageRank Is Nothing Then
lblPR.Text = "n/a"
Else
lblPR.Text = _PageRank
End If
End Sub
Private Function GetResponse(ByVal _G_URL As String) As String
Try
Dim sb As New StringBuilder()
Dim buf As Byte() = New Byte(8191) {}

Dim _HttpWRQ As HttpWebRequest = DirectCast(WebRequest.Create(_G_URL), HttpWebRequest)
Dim _HttpWRS As HttpWebResponse = DirectCast(_HttpWRQ.GetResponse(), HttpWebResponse)

Dim _InStream As Stream = _HttpWRS.GetResponseStream()

Dim _TempString As String = Nothing
Dim _Count As Integer = 0

Do
_Count = _InStream.Read(buf, 0, buf.Length)
If _Count <> 0 Then
_TempString = Encoding.ASCII.GetString(buf)
sb.Append(_TempString)
End If
Loop While _Count > 0

Return sb.ToString()
Catch nse As NotSupportedException
Throw nse
Catch we As WebException
Throw we
Catch pve As ProtocolViolationException
Throw pve
Catch ioe As InvalidOperationException
Throw ioe
Catch ex As Exception

Return "0"
End Try
End Function

Private Function GetHash(ByVal _SiteURL As String) As String
Dim _Check1 As Long = StrToNum(_SiteURL, 5381, 33)
Dim _Check2 As Long = StrToNum(_SiteURL, 0, 65599)

_Check1 >>= 2

_Check1 = ((_Check1 >> 4) And 67108800) Or (_Check1 And 63)
_Check1 = ((_Check1 >> 4) And 4193280) Or (_Check1 And 1023)
_Check1 = ((_Check1 >> 4) And 245760) Or (_Check1 And 16383)

Dim T1 As Long = ((((_Check1 And 960) << 4) Or (_Check1 And 60)) << 2) Or (_Check2 And 3855)
Dim T2 As Long = ((((_Check1 And 4294950912) << 4) Or (_Check1 And 15360)) << 10) Or (_Check2 And 252641280)

Return Convert.ToString(T1 Or T2)
End Function

Private Function CheckHash(ByVal _HashNum As String) As String
Dim _CheckByte As Long = 0
Dim _Flag As Long = 0

Dim _tempI As Long = Convert.ToInt64(_HashNum)
If _tempI < 0 Then
_tempI = _tempI * (-1)
End If
Dim _Hash As String = _tempI.ToString()
Dim _Length As Integer = _Hash.Length
For x As Integer = _Length - 1 To 0 Step -1

Dim _quick As Char = _Hash(x)
Dim _Re As Long = Convert.ToInt64(_quick.ToString())
If 1 = (_Flag Mod 2) Then
_Re += _Re
_Re = CLng(((_Re / 10) + (_Re Mod 10)))
End If
_CheckByte += _Re
_Flag += 1
Next

_CheckByte = _CheckByte Mod 10
If 0 <> _CheckByte Then
_CheckByte = 10 - _CheckByte
If 1 = (_Flag Mod 2) Then
If 1 = (_CheckByte Mod 2) Then
_CheckByte >>= 1
End If
End If
End If

If _Hash.Length = 9 Then
_CheckByte += 5
End If

Return "7" + _CheckByte.ToString() + _Hash
End Function
Private Function StrToNum(ByVal _str As String, ByVal _Chk As Long, ByVal _Magic As Long) As Long
Dim _Int64Unit As Long = Convert.ToInt64(Math.Pow(2, 32))

Dim _StrLen As Integer = _str.Length
For x As Integer = 0 To _StrLen - 1

_Chk *= _Magic

If _Chk >= _Int64Unit Then
_Chk = (_Chk - (_Int64Unit * Convert.ToInt64(_Chk / _Int64Unit)))

_Chk = IIf((_Chk < -2147483648), (_Chk + _Int64Unit), _Chk)
End If
_Chk += CLng(_str(x))
Next

Return _Chk
End Function
End Class

-----------------------------------------------
THe StrToNum function gives me a warning in my code before running
'Char' values cannot be converted to 'Long'. Use 'Microsoft.VisualBasic.AscW' to interpret a character as a Unicode value or 'Microsoft.VisualBasic.Val' to interpret it as a digit.

So if I change the code to either:
_Chk += CLng(AscW(_str(x)))
or
_Chk += CLng(Val(_str(x)))

Like recommeded by VS 2005 then I get no error and can run the app, but then once I enter a site to check I get this error:

------------------------------------------------------------------
Arithmetic operation resulted in an overflow.
Description: An unhandled exception occurred during the execution of the current web request. Please review the stack trace for more information about the error and where it originated in the code.

Exception Details: System.OverflowException: Arithmetic operation resulted in an overflow.

Source Error:

Line 295: For x As Integer = 0 To _StrLen - 1
Line 296:
Line 297: _Chk *= _Magic
Line 298:
Line 299: If _Chk >= _Int64Unit Then

--------------------------------------------------------
Anyone care to take a stab at this or at least point me in the right dirrection?

 

Without importing the code in VS, try clng(val(_str.chars(x)))

 

Same error is produced when I run the application.

 

Aaron Reynolds is being nice enough to help us poor vb.net schlumps convert this code into our native tounge

With his permission I will post it here when done, or he may, not sure.

 

Is there any chance that someone could take the orginal CS version of this code and compile it into a working class, or just convert it to a working class and I will compile it so I can make use of this in my VB project. I have tried and tried and tried without success to change this from a code beside file to a class, and I have ended up with nothing but errors that I can't seem to fix.

Thanks,

 

In response to the above request for a VB.Net version, try this.

I did a straight conversion from C# to VB.Net and I found that the integer handling was different - turned out to be me using the standard division operator instead of the integer division operator.

I've quickly tested it but I'm sure you will let me know if it doesn't work. Both C# and VB.Net versions of the source code are in the ZIP file but the demo form is written in C# - compiled though so if you don't have C# capabilities you can still test it using the EXE file in the "PageRank\TestPR\bin\debug" directory.

So here it is: download pagerank tool code in VB.net and C# You can download the file from my blog page.

If you use this in your code or on your website, I'd appreciate you linking back to my website.

Enjoy