Извлечение ссылки из HTML страницы

Иногда нужно лишь извлечь ссылку из HTML документа (URL). Нам же нужно получить атрибуты всех тегов HREF.

Здесь приведен пример, как можно извлечь все ссылки из HTML-документа. Процедура ExtractLinks заполняет объект TStrings значениями атрибутов тега HREF из HTML-документа.

uses mshtml, ActiveX, COMObj, IdHTTP, idURI;

//извлекаем атрибуты "href" тега A из URL в TStrings
procedure ExtractLinks(const url: String; const strings: TStrings) ;
var
    iDoc : IHTMLDocument2;
    strHTML : string;
    v : Variant;
    x : integer;
    links : OleVariant;
    docURL : string;
    URI : TidURI;
    aHref : string;
    idHTTP : TidHTTP;
begin
   strings.Clear;
   URI := TidURI.Create(url) ;
   try
     docURL := 'http://' + URI.Host;
     if URI.Path <> '/' then docURL := docURL + URI.Path;
   finally
     URI.Free;
   end;
   iDoc := CreateComObject(Class_HTMLDOcument) as IHTMLDocument2;
   try
     iDoc.designMode := 'on';
     while iDoc.readyState <> 'complete' do Application.ProcessMessages;
     v := VarArrayCreate([0,0],VarVariant) ;
     idHTTP := TidHTTP.Create(nil) ;
     try
       strHTML := idHTTP.Get(url) ;
     finally
       idHTTP.Free;
     end;
     v[0]:= strHTML;
     iDoc.write(PSafeArray(System.TVarData(v).VArray)) ;
     iDoc.designMode := 'off';
     while iDoc.readyState<>'complete' do Application.ProcessMessages;
     links := iDoc.all.tags('A') ;
     if links.Length > 0 then
     begin
       for x := 0 to -1 + links.Length do
       begin
         aHref := links.Item(x).href;
         if (aHref[1] = '/') then
           aHref := docURL + aHref
         else if Pos('about:', aHref) = 1
           then aHref := docURL + Copy(aHref, 7, Length(aHref)) ;
         strings.Add(aHref) ;
       end;
     end;
   finally
     iDoc := nil;
   end;
end;