В большинстве случаев Вы используете 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;
|