Google PR Script

i seen quite a few in PHP. does anybody have a script for Google PR written in ASP .NET?

 

Hello,

You can use this php script in asp.net also. I am using in asp & asp.net if you required help on this you can tell me....I am calling php script from asp & asp.net.

 

thanks, let me try this. i didnt think of this. I will let you know how it goes.

 

I have one for VB - which is instantly convertable to ASP... drop me a pm later tonight and I'll throw it your way when I get home

 

I found one in ASP, you would have to translate to .net
http//www.locazo.net:81/ASP/GETRANKASPv01.asp

 

ccoonen,

I could use the asp compatible one if you don't mind sharing

 

Thank you. That link isnt working. Takes to a google page.

 

i did the conversion from php upto calculating the checksum.
i m having problem reading the file suppressing error.

 

Hello webcosmo,

As i have said early i have everything ready you can PM if you required further assistance

 

I tried many times to find one, locazio didn't even send the link

I decided to use a PHP script and write it in ASP but didn't have time.

And lately I noticed that many checkers are not working

 

yep ludwig you are right, i saw the same.

 

I think this was working. If not let me know....
<%
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


Function GetRank(sURL)
response.redirect "http://www.google.com/search?client=navclient-auto&ch=" & sURL & "&features=Rank&q=" & "info:" & sURL
End Function

GetRank("www.google.com")
%>

 

I am insterest also with PR script in ASP classic or .NET

The above link was not work

The code from Aztral also did not work either, it produce Forbidden message, any help?

 

Oops! Sorry

replace
response.redirect "http://www.google.com/search?client=navclient-auto&ch=" & sURL & "&features=Rank&q=" & "info:" & sURL

with

response.redirect "http://www.google.com/search?client=navclient-auto&ch=" & CalculateChecksum(sURL) & "&features=Rank&q=" & "info:" & sURL

This works...
<-- slacker tested it

 

I had a few other threads with this info

 

Glad to help !

 

I get an error with google when using the above code snippet.

Forbidden
Your client does not have permission to get URL /search?client=navclient-auto&ch=61967499896&features=Rank&q=info:www.google.com from this server. (Client IP address: 24.89.254.172)

Please see Google's Terms of Service posted at http://www.google.com/terms_of_service.html

Anyone know why this could be?

 

make sure not to "ABUSE" the PR getting via your IP. It does get tracked and any overuse of this with one IP can flag your IP and display errors (not display the PR)

 

weird, this is the first script that i've tried, and this happened on the first try...any other suggestions?

 

I've done a version in C#.

I'll try and post it here tomorrow or you can email/MSN me for it via my profile.