function TGetMailBand.SetSite(const pUnkSite: IUnknown): HResult;  stdcall;
var
        pOleWindow:IOleWindow;
        pOleEcmd:IOleCommandTarget;
        pSP :IServiceProvider;
        rc:TRect;
begin
        if Assigned(pUnkSite) then
        begin
                m_hwndParent:=0;
                m_pSite:=pUnkSite as IInputObjectSite;
                pOleWindow:=punkSite as IOLeWindow;
                //获得父窗口IE面板窗口的句柄
                pOleWindow.GetWindow(m_hwndParent);
                if (m_hwndParent=0) then
                begin
                        Result:=E_FAIL;
                        exit;
                end;
                //获得父窗口区域
                GetClientRect(m_hwndParent,rc);
                if not Assigned(frmIE) then
                begin
                        //建立TIEForm窗口,父窗口为m_hwndParent
                        frmIE:=TForm1.CreateParented(m_hwndParent);
                        m_Hwnd:=frmIE.Handle;
                        SetWindowLong(frmIE.Handle,GWL_STYLE,GetWindowLong(frmIE.Handle ,GWL_STYLE) or WS_CHILD);
                        //根据父窗口区域设置窗口位置
                        with frmIE do begin
                                Left:=rc.Left;
                                Top:=rc.Top;
                                Width:=rc.Right-rc.Left;
                                Height:=rc.Bottom-rc.Top;
                        end;
                        frmIE.Visible:=True;
                        //获得与浏览器相关联的Webbrower对象。
                        pOLEcmd:=pUnkSite as IOleCommandTarget;   //205
                        pSP:=pOLEcmd as IServiceProvider;         //206
                        if Assigned(pSP) then begin
                                pSP.QueryService(IWebbrowserApp,IWebbrowser2,frmIE.IEThis);
                end;
       end;
end;
Result:=S_OK;
end;function TGetMailBand.ShowDW(fShow: BOOL): HResult; stdcall;
begin
        if m_hWnd<>0 then
                if fShow then
                        ShowWindow(m_hWnd,SW_SHOW)
                else
                        ShowWindow(m_hWnd,SW_HIDE) ;
        Result:=S_OK;
end;//TIEClassFac类实现COM组件的注册
Type
        TIEClassFac=class(TComObjectFactory)
        public
                procedure UpdateRegistry(Register:Boolean);override;
end;{ TIEClassFac }procedure TIEClassFac.UpdateRegistry(Register: Boolean);
var
        ClassID:String;
        a:Integer;
begin
  inherited UpdateRegistry(Register);
  if Register then begin
        ClassID:=GUIDToString(Class_GetMailBand) ;
        with TRegistry.Create  do
        try
        //添加附加的注册表项
                RootKey:=HKEY_LOCAL_MACHINE;
                OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
                a:=0;
                WriteBinaryData(GUIDToString(Class_GetMailBand),a,0);
                OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);
                WriteString(GUIDToString(Class_GetMailBand),EB_CLASS_NAME);
                RootKey:=HKEY_CLASSES_ROOT;
                OpenKey('\CLSID\'+GUIDToString(Class_GetMailBand),False);
                WriteString('',EB_CLASS_NAME);
        finally
                Free;
        end;
  end
  else begin
        with TRegistry.Create do
        try
                RootKey:=HKEY_LOCAL_MACHINE;
                OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar\',False);
                DeleteValue(GUIDToString(Class_GetMailBand));
                OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved\',False);
                DeleteValue(GUIDToString(Class_GetMailBand));
        finally;
                Free;
        end;
  end;
end;initialization
  TIEClassFac.Create(ComServer, TGetMailBand, Class_GetMailBand, 'GetMailAddress', '', ciMultiInstance, tmApartment);
end.
library MailIEBand;uses
  ComServ,
  BandUnit in 'BandUnit.pas',
  IEForm in 'IEForm.pas' {Form1};
  MailIEBand_TLB in 'MailIEBand_TLB.pas',
   exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;{$R *.TLB}{$R *.RES}begin
end.unit IEForm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ShDocVW, MSHTML, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    ComboBox1: TComboBox;
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
        IEThis:IWebbrowser2;
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormResize(Sender: TObject);
begin
        with Button1 do begin
                Left:=0;
                Top:=0;
                Height:=Self.ClientHeight ;
        end;
        with ComboBox1 do begin
                Left:=Button1.Width +3;
                Top:=0;
                Height:=Self.ClientHeight;
                Width:=Self.ClientWidth -Left;
        end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
        doc:IHTMLDocument2;
        all:IHTMLElementCollection;
        len,i,flag:integer;
        item:IHTMLElement;
        vAttri:Variant;
begin
        if Assigned(IEThis) then begin
                ComboBox1.Clear ;
                //获得Webbrowser对象中的文档对象
                doc:=IEThis.Document as IHTMLDocument2;
                //获得文档中所有的HTML元素集合
                all:=doc.Get_all;
                len:=all.Get_length ;
                //访问HTML元素集合中的每一个元素
                for i:=0 to len-1 do begin
                        item:=all.item(i,varempty) as IHTMLElement;
                        //如果该元素是一个链接
                        if item.Get_tagName='A' then begin
                                flag:=0;
                        vAttri:=item.getAttribute('protocal',flag);//获得链接属性
                        //如果是mailto链接则将链接的目标地址添加到ComboBox1
                        if vAttri='mailto:' then begin
                                vAttri:=item.getAttribute('href',flag);
                                ComboBox1.Items.Add(vAttri);
                        end;
                end;
        end;
end;
end;end.