0

任何人都可以显示示例代码，如何从 delphi 获取 google pagerank？例如使用INDY。我的意思是不使用外部 PHP 脚本。所以我的意思是从delphi直接调用谷歌服务器，解码数据并显示站点（页面）pagerank。

4

1 回答 1

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+）。我假设它将与以前的版本一起编译，但我没有机会对其进行测试。

于 2010-09-15T01:11:48.253 回答