2014-05-19 57 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所以它开始自动处理重定向。