★怎样像“蚂蚁”一样在IE浏览器工具栏上建立一个快捷钮？

http://www.vckbase.com/ 的在线杂志第9期上有，修改注册表即可！
下面是我的一篇稿件，是关于添加一个ComboBox到IE任务栏中的，里面的图片我删除了，如果对你有帮助，别忘了给分 :-)我们知道一些Internet软件能将自身功能集成在IE中，象网络蚂蚁。当设置了浏览器点击整合以后。如果用户点击IE页面中的指向.Exe、.Zip文件的连接后，蚂蚁会自动启动，下载连接指向地址的文件。这就是利用了IE扩展的功能实现的。
实现IE扩展的基本方法如下：建立一个COM服务器，编写代码使COM对象实现系统规定的若干接口（这些接口在Delphi的库中已经定义好了）。然后注册服务器并将COM对象的信息写入系统注册表中规定的位置。IE在运行时会通过注册表信息调用相应的COM对象中的方法从而实现IE扩展。
在下面的实例中，将建立一个IE工具栏(Explorer Bars)。在工具栏中放置一个按钮和一个下拉框，当用户点击按钮后，程序会自动获取IE页面中的所有电子邮件地址连接并将它添加到下拉列表框中。在这个范例内可以学习到如何在一个COM服务器中建立多个COM对象、在COM对象中实现多接口以及一些InternetExplorer对象的编程方法。需要实现的接口
实现添加工具栏功能的COM对象需要实现以下的接口：
IDeskBand
IObjectWithSite
IPersistStream IDeskBand接口用于处理工具栏，例如工具栏大小的改变，用户选择显示或隐藏工具栏等。接口在ShlObj.pas下有定义。
IObjectWithSite接口用于处理包含工具栏的对象，在ActiveX.pas下有定义。
IPersistStream接口用于处理附加的信息。该接口并不需要，所以所有的方法都返回E_NOTIMPL，接口在ActiveX.pas下有定义。
这些接口的详细信息在微软的MSDN中都有详细的描述以及范例。提示
MSDN(Microsoft Develop Network)是微软提供的Windows开发手册，也是最完整和翔实的Windows开发手册，包含了开发微软各个系统的帮助，Bug列表，范例等等。对于Windows下的程序员，无论是否使用微软的开发工具，都应该在自己的机器中安装MSDN。

IE扩展的实现
同上面建立COM服务器一样，我们首先要建立一个ActiveX Library。将其保存为MailIEBand.Dpr；然后建立一个COM Object，将其保存为BandUnit.pas；然后建立一个Form，这个窗口将作为子窗口显示在IE工具栏中，将窗口的BorderStyle属性改为bsNone，添加一个TButton组件和一个TComboBox组件，将TButton的Caption属性改为获取全部，然后将窗口文件其保存为IEForm.pas。
在BandUnit中，需要建立一个实现上面提到的接口的TComObject对象。如下：
TGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)另外由于需要在COM服务器注册时添加一些注册表信息，所以还需要建立一个继承自TComObjectFactory类的对象，在对象的UpdateRegistry事件中编写代码添加附加的注册表信息。
下面的程序清单3-1到3-3是实现COM服务器的全部程序代码：程序清单3-1 MailIEBand.dpr
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.程序清单3-2 BandUnit.pasunit BandUnit;interfaceuses
  Windows, Sysutils, Messages, Registry, Shellapi, ActiveX, Classes, ComObj,
   Shlobj, Dialogs, Commctrl,ShDocVW,IEForm;type
  TGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)
  private
      frmIE:TForm1;
      m_pSite:IInputObjectSite;
   m_hwndParent:HWND;
   m_hWnd:HWND;
   m_dwViewMode:Integer;
      m_dwBandID:Integer;
   protected   public
    {Declare IDeskBand methods here}
      function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
         HResult; stdcall;
      function ShowDW(fShow: BOOL): HResult; stdcall;
      function CloseDW(dwReserved: DWORD): HResult; stdcall;
      function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;
         fReserved: BOOL): HResult; stdcall;
      function GetWindow(out wnd: HWnd): HResult; stdcall;
      function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;      {Declare IObjectWithSite methods here}
      function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
      function GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;      {Declare IPersistStream methods here}
      function GetClassID(out classID: TCLSID): HResult; stdcall;
      function IsDirty: HResult; stdcall;
      function InitNew: HResult; stdcall;
      function Load(const stm: IStream): HResult; stdcall;
      function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
      function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
  end;const
  Class_GetMailBand: TGUID = '{954F618B-0DEC-4D1A-9317-E0FC96F87865}';
  //以下是系统接口的IID
  IID_IUnknown: TGUID = (
      D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  IID_IOleObject: TGUID = (
      D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  IID_IOleWindow: TGUID = (
      D1:$00000114;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));  IID_IInputObjectSite : TGUID = (
      D1:$f1db8392;D2:$7331;D3:$11d0;D4:($8C,$99,$00,$A0,$C9,$2D,$BF,$E8));
  sSID_SInternetExplorer : TGUID = '{0002DF05-0000-0000-C000-000000000046}';
  sIID_IWebBrowserApp : TGUID= '{0002DF05-0000-0000-C000-000000000046}';  //面板所允许的最小宽度和高度。
  MIN_SIZE_X = 54;
  MIN_SIZE_Y = 22;
  EB_CLASS_NAME = 'GetMailAddress';
implementationuses ComServ;
function TGetMailBand.GetWindow(out wnd: HWnd): HResult; stdcall;
begin
   wnd:=m_hWnd;
   Result:=S_OK;
end;function TGetMailBand.ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
begin
   Result:=E_NOTIMPL;
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;function TGetMailBand.CloseDW(dwReserved: DWORD): HResult; stdcall;
begin
   if frmIE<>nil then
      frmIE.Destroy;
   Result:= S_OK;
end;function TGetMailBand.ResizeBorderDW(var prcBorder: TRect;
      punkToolbarSite: IUnknown;fReserved: BOOL): HResult; stdcall;
begin
   Result:=E_NOTIMPL;
end;function TGetMailBand.SetSite(const pUnkSite: IUnknown):HResult;stdcall;
var
   pOleWindow:IOleWindow;
   pOLEcmd: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;         //获得与浏览器相关联的Webbrowser对象。
         pOLEcmd:=pUnkSite as IOleCommandTarget;
         pSP:=pOLEcmd as  IServiceProvider;         if Assigned(pSP)then begin
           pSP.QueryService(IWebbrowserApp, IWebbrowser2,frmIE.IEThis);
         end;
      end;
   end;   Result := S_OK;
end;function TGetMailBand.GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;
begin
   if Assigned(m_pSite) then result:=m_pSite.QueryInterface(riid, site)
   else
     Result:= E_FAIL;
end;function TGetMailBand.GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
      HResult; stdcall;
begin
   Result:=E_INVALIDARG;
   if not Assigned(frmIE) then frmIE:=TForm1.CreateParented(m_hwndParent);
   if(@pdbi<>nil)then begin
      m_dwBandID := dwBandID;
      m_dwViewMode := dwViewMode;      if(pdbi.dwMask and DBIM_MINSIZE)<>0 then begin
         pdbi.ptMinSize.x := MIN_SIZE_X;
         pdbi.ptMinSize.y := MIN_SIZE_Y;
      end;      if(pdbi.dwMask and DBIM_MAXSIZE)<>0 then begin
         pdbi.ptMaxSize.x := -1;
         pdbi.ptMaxSize.y := -1;
      end;      if(pdbi.dwMask and DBIM_INTEGRAL)<>0 then begin
         pdbi.ptIntegral.x := 1;
         pdbi.ptIntegral.y := 1;
      end;      if(pdbi.dwMask and DBIM_ACTUAL)<>0 then begin
         pdbi.ptActual.x := 0;
         pdbi.ptActual.y := 0;
      end;      if(pdbi.dwMask and DBIM_MODEFLAGS)<>0 then
         pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT;      if(pdbi.dwMask and DBIM_BKCOLOR)<>0 then
         pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR);
   end;
end;
function TGetMailBand.GetClassID(out classID: TCLSID): HResult; stdcall;
begin
   classID:= Class_GetMailBand;
   Result:=S_OK;
end;function TGetMailBand.IsDirty: HResult; stdcall;
begin
   Result:=S_FALSE;
end;function TGetMailBand.InitNew: HResult;
begin
  Result := E_NOTIMPL;
end;function TGetMailBand.Load(const stm: IStream): HResult; stdcall;
begin
   Result:=S_OK;
end;function TGetMailBand.Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
begin
   Result:=S_OK;
end;function TGetMailBand.GetSizeMax(out cbSize: Largeint): HResult; stdcall;
begin
   Result:=E_NOTIMPL;
end;
//TIEClassFac类实现COM组件的注册
type
   TIEClassFac=class(TComObjectFactory) //
   public
      procedure UpdateRegistry(Register: Boolean); override;
   end;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.程序清单3-3 IEForm.pasunit 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('protocol',flag);     //获得链接属性
        //如果是mailto链接则将链接的目标地址添加到ComboBox1
        if vAttri = 'mailto:'then begin
          vAttri:=item.getAttribute('href',flag);
          ComboBox1.Items.Add(vAttri);
        end;
      end;
    end;
  end;
end;end.编译工程，关闭所有的IE窗口，然后点击Delphi菜单的Run | Register ActiveX Server 项注册服务器。然后打开IE，点击菜单察看 | 工具栏项，可以看到子菜单中多了一个GetMailAddress项，选中改项，工具栏就出现在IE工具栏中，如图：
图1-6 IE工具栏点击获取地址按钮，就可以将当前页面中的Mail地址统统添加到ComboBox1中。
注意上面的IEForm.pas引用到了MSHTML，微软IE的整个结构如下图所示：

图1-7 IE基本架构其中MSHTML是位于SHDOCVW和HTML页面之间的对象。SHDOCVW对象用于处理页面的显示，而MSHTML用于处理页面的语法分析。它可以将页面中的标记（例如<P></P>、< A href></A>）转换为元素，同时它MSHTML又是一个COM服务器，允许客户端访问。所以上面TForm1.Button1Click部分的代码：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('protocol',flag);     //获得链接属性
        //如果是mailto链接则将链接的目标地址添加到ComboBox1
        if vAttri = 'mailto:'then begin
          vAttri:=item.getAttribute('href',flag);
          ComboBox1.Items.Add(vAttri);
        end;
      end;
    end;
  end;
end;就是通过MSHTML定义的接口访问页面中的元素并获得链接元素中的地址。   http://www.applevb.com

调试易

★怎样像“蚂蚁”一样在IE浏览器工具栏上建立一个快捷钮？

解决方案 »