How to get google pagerank from delphi

Question

Anyone can show example code, how to get google pagerank from delphi ? e.g. with usage of INDY. I mean without usage of outer PHP script. So I mean direct call to google server from delphi ,decode data and show site(page) pagerank.

Answer 1

With the code in the thread referenced by @Joe, I managed to produce this Delphi code. Trying to use it, I figured out google uses a different algorithm to check the hash for a Unicode request. With no more references to that algorithm, nor time to continue investigating, I tweaked this a bit to send the request in Ansi characters, using the DirectWrite method of the IOHandler instead of the usual Writeln or IDTCPClient.WriteHeaders.

The important thing is, it seems to work.

class definition:

  TPageRankCalc = class
  private
  protected
    class function PageRankStrToNum(const S: string; Check: Int64; Magic: Cardinal): Int64;
    class function PageRankHashURL(const S: string): Int64;
    class function CheckHash(HashNum: Int64): AnsiString;
  public
    class function SearchURI(const url: AnsiString): AnsiString;
  end;

class implementation:

class function TPageRankCalc.CheckHash(HashNum: Int64): AnsiString;
var
  CheckByte: Int64;
  Flag: Integer;
  HashStr: AnsiString;
  Len: Integer;
  I: Integer;
  Re: Byte;
begin
  CheckByte := 0;
  Flag := 0;
  HashStr := Format('%d', [HashNum]);
  Len := Length(HashStr);
  for I := Len downto 1 do
  begin
    Re := StrToInt(HashStr[I]);
    if (Flag mod 2) = 1 then
    begin
      Re := Re + Re;
      Re := (Re div 10) + (Re mod 10);
    end;
    CheckByte := CheckByte + Re;
    Inc(Flag);
  end;
  CheckByte := CheckByte mod 10;
  if (CheckByte <> 0) then
  begin
    CheckByte := 10 - CheckByte;
    if (Flag mod 2) = 1 then
    begin
      if (CheckByte mod 2) = 1 then
        CheckByte := CheckByte + 9;
      CheckByte := CheckByte shr 1;
    end;
  end;
  Result := '7' + IntToStr(CheckByte) + HashStr;
end;

class function TPageRankCalc.PageRankHashURL(const S: string): Int64;
var
  Check1, Check2: Int64;
  T1, T2: Int64;
begin
  Check1 := PageRankStrToNum(S, $1505, $21);
  Check2 := PageRankStrToNum(S, $0, $1003F);
  Form2.Label5.Caption := FormatBin(Check1);
  Form2.Label8.Caption := FormatBin(Check2);
  Check1 := Check1 shr 2;
  Form2.Label6.Caption := FormatBin(Check1);
  Check1 := ((Check1 shr 4) and $3FFFFC0) or (Check1 and $3F);
  Check1 := ((Check1 shr 4) and $3FFC00) or (Check1 and $3FF);
  Check1 := ((Check1 shr 4) and $3C000) or (Check1 and $3FFF);
  T1 := ((((Check1 and $3C0) shl 4) or (Check1 and $3C)) shl 2) or (Check2 and $F0F);
  T2 := ((((Check1 and $FFFFC000) shl 4) or (Check1 and $3C00)) shl $A) or (Check2 and $F0F0000);
  Result := T1 or T2;
end;

class function TPageRankCalc.PageRankStrToNum(const S: string; Check: Int64; Magic: Cardinal): Int64;
const
  Int32Uint = 4294967296;
var
  _length: integer;
  I: Integer;
begin
  Result := Check;
  _length := Length(S);
  for I := 1 to _length do
  begin
    Result := Result * Magic;
    if (Result >= Int32Uint) then
    begin
      Result := Result - Int32Uint * Integer(Result div Int32UInt);  //should be div?
      if Result < -2147483648 then
        Result := Result + Int32UInt;
    end;
    Result := Result + Ord(S[I]);
  end;
end;

class function TPageRankCalc.SearchURI(const url: AnsiString): AnsiString;
begin
  Result := '/search?client=navclient-auto&ch=' + CheckHash(PageRankHashURL(url)) + '&features=Rank&q=info:'+url+'&num=100&filter=0';
end;

class usage:

procedure TForm2.Button1Click(Sender: TObject);
var
  Msg: AnsiString;
  Rsp: TStringList;
  S: string;
  PIni: Integer;
  sPR: string;
begin
  IdTCPClient1.Host := 'toolbarqueries.google.com';
  IdTCPClient1.Port := 80;
  Msg := '';
  Rsp := TStringList.Create;
  try
    Msg := Msg + Format('GET %s  HTTP/1.1', [TPageRankCalc.SearchURI(LabeledEdit1.Text)]) + #13#10;
    Msg := Msg + 'Host: toolbarqueries.google.com' +  #13#10;
    Msg := Msg + 'User-Agent: Mozilla/4.0 (compatible; GoogleToolbar 2.0.114-big; Windows XP 5.1)' + #13#10;
    Msg := Msg + 'Connection: Close'  + #13#10;
    Msg := Msg + '' + #13#10;  //header end
    IdTCPClient1.Connect;
    try
      IdTCPClient1.IOHandler.WriteDirect(TBytes(@Msg[1]), Length(Msg));
      try
        repeat
          s := IdTCPClient1.IOHandler.ReadLn();
          if IdTCPClient1.IOHandler.ReadLnTimedout then
            S := '';
          Rsp.Add(s);
          IdTCPClient1.IOHandler.ReadStrings(Rsp);
        until false;
      except
        on EIdConnClosedGracefully do
          IdTCPClient1.Disconnect;
      end;
      sPR := 'Error';
      if Rsp[0]='HTTP/1.1 200 OK' then
      begin
        PIni := Pos('Rank_', Rsp[Rsp.Count - 1]);
        if PIni <> 0 then
          sPR := Copy(Rsp[Rsp.Count - 1], PIni + 9, MaxInt);
      end;
      ShowMessage('Page rank is: ' + sPR);
    finally
      if IdTCPClient1.Connected then
        IdTCPClient1.Disconnect;
    end;
  finally
    Rsp.Free;
  end;
end;

Compiler is warning about implicit string casting from AnsiString/Char to string/Char and vice versa. You have to make final refinements on the code to get it to a better work and clean conversions.

I tested it with two or three cases... as I'm not expert translator from php to Delphi, it's a chance I missinterpreted something, so I give it to you AS IS, without any warranty, bla, bla, bla.

It works with modern unicode Delphi versions (2009+). I assume it will compile with previous versions, but I had no chance to test it.