[COM/OLE] 특정 웹페이지의 모든 Link URL 구하기

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, OleServer, MSHTML_TLB, ComObj, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FInternetExplorer: TInternetExplorer;
    procedure WebBrowserDocumentComplete(Sender: TObject; var pDisp: OleVariant; var URL: OleVariant);    
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WebBrowserDocumentComplete(Sender: TObject; var pDisp: OleVariant; var URL: OleVariant);
var
  Doc: IHTMLDocument2;
  ElementCollection: IHTMLElementCollection;
  HtmlElement: IHTMLElement;
  I: Integer;
  AnchorString: string;
begin
  ListBox1.Clear;
  Doc := FInternetExplorer.Document as IHTMLDocument2;
  if Doc = nil then
    raise Exception.Create('failed to get HTML');
    
  ElementCollection := Doc.all;
  for I := 0 to ElementCollection.length - 1 do
  begin
    HtmlElement := ElementCollection.item(I, '') as IHTMLElement;
    if HTMLElement.tagName = 'A' then
    begin
      AnchorString := HtmlElement.innerText;
      AnchorString := AnchorString + ' -  ' + (HtmlElement as IHTMLAnchorElement).href;
      ListBox1.Items.Add(AnchorString);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FInternetExplorer := TInternetExplorer.Create(Self);
  FInternetExplorer.OnDocumentComplete := WebBrowserDocumentComplete;
  Edit1.Text := 'http://www.howto.pe.kr/menu.html';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FInternetExplorer.Navigate(Edit1.Text, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
end;

end.