Question

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;

在某些网站上，此代码会生成一个图片网址列表，但在某些网站上会生成“HTTP / 1.1 301永久移动”EIdHTTPProtocolException。是否有可能从网页网址获取Img网址列表，或者我做错了什么？

Answer 1

设置iIdHTTP.HandleRedirects := True以便它自动开始处理重定向。

'HTTP / 1.1 301永久移动'EIdHTTPProtocolException

1 个答案: