2014-05-19 56 views
1
procedure TForm1.ExtractLinks(const URL: String; const StringList: TStringList); 
{ Extract "href" attribute from A tags from an URL and add to a stringlist. } 
var 
    i: Integer; 
    iDoc: IHTMLDocument2; 
    iHTML: String; 
    iv: Variant; 
    iLinks: OleVariant; 
    iDocURL: String; 
    iURI: TidURI; 
    iHref: String; 
    iIdHTTP: TidHTTP; 
    iListItem: TListItem; 
begin 
    StringList.Clear; 
    ListView1.Clear; 
    iURI := TidURI.Create(URL); 
    try 
    iDocURL := 'http://' + iURI.Host; 
    if iURI.Path <> '/' then 
     iDocURL := iDocURL + iURI.Path; 
    finally 
    iURI.Free; 
    end; 
    iDoc := CreateComObject(Class_HTMLDOcument) as IHTMLDocument2; 
    try 
    iDoc.DesignMode := 'on'; 
    while iDoc.ReadyState <> 'complete' do 
     Application.ProcessMessages; 
    iv := VarArrayCreate([0, 0], VarVariant); 
    iIdHTTP := TidHTTP.Create(nil); 
    try 
     iHTML := iIdHTTP.Get(URL); 
    finally 
     iIdHTTP.Free; 
    end; 
    iv[0] := iHTML; 
    iDoc.Write(PSafeArray(System.TVarData(iv).VArray)); 
    iDoc.DesignMode := 'off'; 
    while iDoc.ReadyState <> 'complete' do 
     Application.ProcessMessages; 
    iLinks := iDoc.All.Tags('A'); 
    if iLinks.Length > 0 then 
    begin 
     ListView1.Items.BeginUpdate; 
     for i := 0 to -1 + iLinks.Length do 
     begin 
     iHref := iLinks.Item(i).href; 
     if (iHref[1] = '/') then 
      iHref := iDocURL + iHref 
     else if Pos('about:', iHref) = 1 then 
      iHref := iDocURL + Copy(iHref, 7, Length(iHref)); 
     if (IsValidURL(iHref)) and (IsKnownFormat(iHref)) then 
     begin 
      StringList.Add(iHref); 
      iListItem := ListView1.Items.Add; 
      iListItem.Caption := iHref; 
     end; 
     ListView1.Items.EndUpdate; 
     end; 
    end; 
    finally 
    iDoc := nil; 
    end; 
end; 

procedure TForm1.GetLinks1Click(Sender: TObject); 
var 
    iUrlList: TStringList; 
begin 
    iUrlList := TStringList.Create; 
    try 
    { Get the url list } 
    ExtractLinks(Url1.Text, iUrlList); 
    finally 
    iUrlList.Free; 
    end; 
end; 

在某些網站這個代碼產生圖像的URL的列表,但在一些網站上它產生一個「HTTP/1.1 301永久移動」 EIdHTTPProtocolException。是否有可能從網頁網址獲取Img網址列表,或者我做錯了什麼?「HTTP/1.1 301已移至永久」 EIdHTTPProtocolException

+2

我想你沒有處理重定向。請參閱此主題:http://stackoverflow.com/questions/4549809/indy-idhttp-how-to-handle-page-redirects –

+0

爲什麼投下了投票?在問一個問題之前,你應該知道一切嗎?我想是這樣,但如果我這樣做了,那麼就不需要這個問題了。 – Bill

+1

因爲只需使用「301 http」可以獲得「URL重定向」主題。那麼你已經知道你在代碼中缺少重定向支持。然後谷歌搜索「indy http重定向」返回你鏈接我c/ped作爲第一個結果給你。 (免責聲明:我沒有downvoted你) –

回答

3

設置iIdHTTP.HandleRedirects := True所以它開始自動處理重定向。