2010-09-14 43 views
0

任何人都可以顯示示例代碼,如何從德爾福獲得谷歌pagerank?例如使用INDY。 我的意思是不使用外部PHP腳本。所以我的意思是從delphi直接調用谷歌服務器,解碼數據和顯示網站(頁面)pagerank。如何從delphi獲得谷歌pagerank

+1

爲什麼不把這個代碼移植到delphi? http://stackoverflow.com/questions/3588751/php-script-to-show-google-ranking-results/3590933#3590933 – 2010-09-14 21:12:47

回答

2

隨着@Joe引用的線程中的代碼,我設法產生這個Delphi代碼。試圖使用它,我想通過谷歌使用不同的算法來檢查散列的Unicode請求。沒有更多的參考算法,也沒有時間繼續調查,我調整了這一點,以Ansi字符發送請求,使用IOHandler的DirectWrite方法,而不是通常的Writeln或IDTCPClient.WriteHeaders。

重要的是,它似乎工作。

類定義:

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類型/字符字符串/字符和反之亦然。您必須對代碼進行最後的改進才能使其得到更好的工作並清除轉換。

我測試了兩個或三個案例...因爲我不是專業翻譯從PHP到Delphi,這是一個機會,我錯過了一些東西,所以我把它給你,沒有任何擔保,bla,bla ,bla。

它適用於現代Unicode德爾福版本(2009+)。我認爲它會與以前的版本編譯,但我沒有機會測試它。