0

誰でもサンプルコードを表示できます.delphiからgoogle pagerankを取得する方法は? たとえば、INDY を使用した場合。つまり、外側の PHP スクリプトを使用しないということです。つまり、デルファイから Google サーバーを直接呼び出し、データをデコードし、サイト (ページ) のページランクを表示することを意味します。

4

1 に答える 1

2

@Joe が参照するスレッド内のコードを使用して、この Delphi コードを作成することができました。それを使用しようとすると、Google が別のアルゴリズムを使用して Unicode リクエストのハッシュをチェックすることがわかりました。そのアルゴリズムへの参照がなくなり、調査を続ける時間がなくなったので、通常の Writeln または IDTCPClient.WriteHeaders の代わりに IOHandler の DirectWrite メソッドを使用して、リクエストを 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 へ、およびその逆の暗黙的な文字列キャストについて警告しています。コードをより適切に機能させ、変換をクリーンにするために、コードを最終的に調整する必要があります。

私は 2 つまたは 3 つのケースでテストしました... 私は php から Delphi への翻訳の専門家ではないので、何かを誤って解釈した可能性があるため、保証なしで現状のまま提供します。

最新の Unicode Delphi バージョン (2009 以降) で動作します。以前のバージョンでコンパイルできると思いますが、テストする機会がありませんでした。

于 2010-09-15T01:11:48.253 に答える