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-адресов изображений, но на некоторых веб-сайтах он создает исключение EIdHTTPProtocolException «HTTP/1.1 301 Moved Permanently». Можно ли получить список URL-адресов Img из URL-адреса веб-страницы или я что-то делаю неправильно?
