Search results for 'TidURI'. 1 post(s) found.
Here's how to obtain all image links from an HTML document. The
GetImageLinks procedure fills a TStrings object with the value of the
SRC property of the IMG HTML element.
Note: if the images have relative links, you will have to parse the document url and prepend that to the image src.
Tip submitted by "mrbaseball34" (an About Delphi Programming member).
uses ... mshtml, ActiveX, COMObj, IdHTTP, idURI;
procedure GetImageLinks(AURL: String; AList: TStrings) ;
var
IDoc : IHTMLDocument2;
strHTML : String;
v : Variant;
x : integer;
ovLinks : OleVariant;
DocURL : String;
URI : TidURI;
ImgURL : String;
IdHTTP : TidHTTP;
begin
AList.Clear;
URI := TidURI.Create(AURL) ;
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(AURL) ;
finally
IdHTTP.Free;
end;
v[0]:= strHTML;
IDoc.write(PSafeArray(System.TVarData(v).VArray)) ;
IDoc.designMode:='off';
while IDoc.readyState<>'complete' do
Application.ProcessMessages;
ovLinks := IDoc.all.tags('IMG') ;
if ovLinks.Length > 0 then
begin
for x := 0 to ovLinks.Length-1 do
begin
ImgURL := ovLinks.Item(x).src;
// The stuff below will probably need a little tweaking
// Deteriming and turning realtive URLs into absolute URLs
// is not that difficult but this is all I could come up with
// in such a short notice.
if (ImgURL[1] = '/') then
begin
// more than likely a relative URL so
// append the DocURL
ImgURL := DocURL + ImgUrl;
end
else
begin
if (Copy(ImgURL, 1, 11) = 'about:blank') then
begin
ImgURL := DocURL + Copy(ImgUrl, 12, Length(ImgURL)) ;
end;
end;
AList.Add(ImgURL) ;
end;
end;
finally
IDoc := nil;
end;
end;
//Usage
procedure TForm1.Button1Click(Sender: TObject) ;
begin
GetImageLinks('http://kurapa.com', Memo1.Lines) ;
end;
procedure GetImageLinks(AURL: String; AList: TStrings) ;
var
IDoc : IHTMLDocument2;
strHTML : String;
v : Variant;
x : integer;
ovLinks : OleVariant;
DocURL : String;
URI : TidURI;
ImgURL : String;
IdHTTP : TidHTTP;
begin
AList.Clear;
URI := TidURI.Create(AURL) ;
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(AURL) ;
finally
IdHTTP.Free;
end;
v[0]:= strHTML;
IDoc.write(PSafeArray(System.TVarData(v).VArray)) ;
IDoc.designMode:='off';
while IDoc.readyState<>'complete' do
Application.ProcessMessages;
ovLinks := IDoc.all.tags('IMG') ;
if ovLinks.Length > 0 then
begin
for x := 0 to ovLinks.Length-1 do
begin
ImgURL := ovLinks.Item(x).src;
// The stuff below will probably need a little tweaking
// Deteriming and turning realtive URLs into absolute URLs
// is not that difficult but this is all I could come up with
// in such a short notice.
if (ImgURL[1] = '/') then
begin
// more than likely a relative URL so
// append the DocURL
ImgURL := DocURL + ImgUrl;
end
else
begin
if (Copy(ImgURL, 1, 11) = 'about:blank') then
begin
ImgURL := DocURL + Copy(ImgUrl, 12, Length(ImgURL)) ;
end;
end;
AList.Add(ImgURL) ;
end;
end;
finally
IDoc := nil;
end;
end;
//Usage
procedure TForm1.Button1Click(Sender: TObject) ;
begin
GetImageLinks('http://kurapa.com', Memo1.Lines) ;
end;
Another posts included in "Delphi"
| How to Activate/Deactivate the Screen Saver (0) | 2007/09/19 |
| How to capture the output from a DOS (command/console) Window (0) | 2007/09/19 |
| How to Change the Windows Start button bitmap (0) | 2007/09/19 |
| List All Network Drives (0) | 2007/09/18 |
| How to set the "home page" for the Internet Explorer from Delphi code (0) | 2007/09/18 |
| How to get get IE favorites (0) | 2007/09/18 |
| Extracting the domain (host) name from an e-mail address (0) | 2007/09/18 |
| Download a file from the Internet with progress indicator (0) | 2007/09/18 |
ActiveX,
Class_HTMLDOcument,
COMObj,
CreateComObject,
Delphi Internet,
Delphi Intranet,
Delphi Networking,
GetImageLinks,
IdHTTP,
idURI,
IHTMLDocument2,
mshtml,
PSafeArray,
TidHTTP,
TidURI,
VarArrayCreate
Trackback : Cannot send a trackbact to this post.
-
Subject different money making ideas
2010/01/28 23:05
moneyideas
-
Subject different money making ideas
2010/01/29 07:09
moneyideas
-
Subject different money making ideas
2010/01/31 16:40
moneyideas
Prev
Rss Feed