calculate checksum for google toolbar pagerank with delphi

Question

here is the general url to request a pagerank : http://toolbarqueries.google.com/tbr?client=navclient-auto&features=Rank&ch=SITECHECKSUM&q=info:SITENAME.com

here is a working example url: http://toolbarqueries.google.com/tbr?client=navclient-auto&features=Rank&ch=64012521073&q=info:http://www.yanniel.info/

How do you calculate the checksum with delphi?

Answer 1

This page purports to contain the checksum algorithm: http://automateeverything.tumblr.com/post/19951549637/google-page-rank-bash-script

The code there is in C but it's simple enough to port it to Delphi. Or even to just compile it to .obj and link in directly.

Here's my quick attempt at a port. Perhaps you'll find it useful. I'd certainly want to do some proper testing of this before using it for real.

{$OVERFLOWCHECKS OFF}
program pagerank;

{$APPTYPE CONSOLE}

uses
  SysUtils;

function ConvertStrToInt(pStr: PAnsiChar; Init, Factor: Integer): Integer;
begin
  Result := Init;
  while pStr^<>#0 do
  begin
    Result := Result*Factor;
    inc(Result, ord(pStr^));
    inc(pStr);
  end;
end;

function HashURL(pStr: PAnsiChar): Integer;
var
  C1, C2, T1, T2: Cardinal;
begin
  C1 := ConvertStrToInt(pStr, $1505, $21);
  C2 := ConvertStrToInt(pStr, 0, $1003F);
  C1 := C1 shr 2;
  C1 := ((C1 shr 4) and $3FFFFC0) or (C1 and $3F);
  C1 := ((C1 shr 4) and $3FFC00) or (C1 and $3FF);
  C1 := ((C1 shr 4) and $3C000) or (C1 and $3FFF);

  T1 := (C1 and $3C0) shl 4;
  T1 := T1 or (C1 and $3C);
  T1 := (T1 shl 2) or (C2 and $F0F);

  T2 := (C1 and $FFFFC000) shl 4;
  T2 := T2 or (C1 and $3C00);
  T2 := (T2 shl $A) or (C2 and $F0F0000);

  Result := Integer(T1 or T2);
end;

function CheckHash(HashInt: Cardinal): AnsiChar;
var
  Check, Remainder: Integer;
  Flag: Boolean;
begin
  Check := 0;
  Flag := False;
  repeat
    Remainder := HashInt mod 10;
    HashInt := HashInt div 10;
    if Flag then
    begin
      inc(Remainder, Remainder);
      Remainder := (Remainder div 10) + (Remainder mod 10);
    end;
    inc(Check, Remainder);
    Flag := not Flag;
  until HashInt=0;

  Check := Check mod 10;
  if Check<>0 then
  begin
    Check := 10-Check;
    if Flag then
    begin
      if (Check mod 2)=1 then
        inc(Check, 9);
      Check := Check shr 1;
    end;
  end;
  inc(Check, $30);
  Result := AnsiChar(Check);
end;

function PageRankCheckSum(const URL: string): string;
var
  HashInt: Cardinal;
begin
  HashInt := Cardinal(HashURL(PAnsiChar(AnsiString(URL))));
  Result := Format('7%s%u', [CheckHash(HashInt), HashInt]);
end;

procedure Main;
begin
  if ParamCount<>1 then
  begin
    Writeln(Format('Usage: %s [URL]', 
      [ChangeFileExt(ExtractFileName(ParamStr(0)), '')]));
    exit;
  end;

  Writeln('Checksum='+PageRankCheckSum(ParamStr(1)));
end;

begin
  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.