往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.

程序清單1-7 BandUnit.pas

unit BandUnit;

interface

uses
  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

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對象。