如何从德尔福获取谷歌pagerank

时间:2010-09-14 21:09:55

标签: delphi pagerank

任何人都可以展示示例代码,如何从delphi获取google pagerank?例如使用INDY。 我的意思是不使用外部PHP脚本。所以我的意思是直接从delphi调用google服务器,解码数据并显示网站(页面)pagerank。

1 个答案:

答案 0 :(得分:2)

使用@Joe引用的线程中的代码,我设法生成了这个Delphi代码。尝试使用它,我发现谷歌使用不同的算法来检查Unicode请求的哈希值。由于没有更多对该算法的引用,也没有时间继续调查,我使用IOHandler的DirectWrite方法而不是通常的Writeln或IDTCPClient.WriteHeaders,调整了一些以Ansi字符发送请求。

重要的是,它似乎有效。

类定义:

  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 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;

课程用法:

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;

编译器警告有关从AnsiString / Char到string / Char的隐式字符串转换,反之亦然。您必须对代码进行最后的改进,以使其更好地完成工作并清理转换。

我用两三个案例进行了测试......因为我不是从php到Delphi的专家翻译,所以我很想忘记解释的东西,所以我按原样给你,没有任何保证,bla,bla, BLA。

它适用于现代unicode Delphi版本(2009+)。我假设它将使用以前的版本编译,但我没有机会测试它。