谁会做像baidu.com一样的IE工具条？ 或者谁有源代码？

Question

谁会做像baidu.com一样的IE工具条？ 或者谁有源代码？

Answer 1

往IE中嵌入工具条        中国软件开发网络 --> 开发图书馆 --> Delphi --> Internet --> 往IE中嵌入工具条  关键字:IE Extension;Delphi;Band;  贴文时间2001-5-14 17:25:00  文章类型: 原作     TechnoFantasy    原作  出处:    我们首先要建立一个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.dprlibrary 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}beginend.程序清单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';implementation

Answer 2

uses 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;

Answer 3

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

Answer 4

请问一下TGetMailBand这个类  怎么建立的请说具体点好吗。

Answer 5

http://seav.y365.com/a-seav/看看我的主页,上面有.需要源码请与我联系.