Программирование Delphi

В большинстве случаев Вы используете TWebBrowser для отображения HTML-документов, таким образом, создавая свою версию интернет-браузера по аналогии с Internet Explorer.

Одна из особенностей браузера заключается в отображении информации о ссылке, например, в строке состояния, когда мышь находится над ссылкой. Это можно сделать и в Delphi: получить адрес ссылки, когда мышь движется над ссылкой в документе TWebBrowser.

Иногда нужно лишь извлечь ссылку из 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;