你察看一下IE的菜单中的 察看->浏览栏 中是否有导航条名称,如果增加了工具条,是在这个菜单下面显示和设置的。

解决方案 »

  1.   

    没有,什么都没有。没有写注册表,没有进程
    可能是使用Hook,但是具体细节没有头绪!再议论!!
    谢谢。
      

  2.   

    别争了!其实是用COM,就是个ActiveX控件!
      

  3.   

    往IE中嵌入工具条      我们首先要建立一个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事件中编写代码添加附加的注册表信息。下面的程序清单1-6到1-8是实现COM服务器的全部程序代码:程序清单1-6 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.
      

  4.   

    程序清单1-7 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;
      

  5.   

    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.
      

  6.   

    程序清单1-8 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工具栏中
      

  7.   

    我装了一个Messanger,没有发现它添加工具栏,只看到增加了一个按钮。
      

  8.   

    是Yahoo Messager,不是MSN Messager!
      

  9.   

    TechnoFantasy(www.applevb.com):
    上面的文章末尾有www.applevb.com,你写的?:)
      

  10.   

    哦,打开一个新窗口就看到了,应该它使用了子分类技术实现的,建议你用spy这样的工具看一下工具栏是如何实现的。
      

  11.   

    实际上你用IE扩展实现也是一样的。上面 ehom(?!) 帖的是我写的一个文章,用它也可以实现一样的功能。
      

  12.   

    先谢谢各位的帮助。
    但是ehom(?!)的方法我也试过了,是通过写注册表的方法把Toolbar嵌入的,可是Yahoo Messager并没有写注册表,我就是认为此处是其高明之处。但不知道如何实现。会不会使用了Hook?
    希望大家继续讨论,一起进步!谢!