bandunit.~pas

ie工具栏源代码！这是一个ie的添加空间

unit BandUnit;

interface

uses
  Windows, Sysutils, Messages, Registry, Shellapi, ActiveX, Classes, ComObj,
  Shlobj, Dialogs, Commctrl, ShDocVW, IEForm, StdVcl;
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
      {声明IDeskBand方法}
    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;

      {声明IObjectWithSite方法}
    function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
    function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;

      {声明IPersistStream方法}
    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 = 250;
  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
  //如果pUnkSite不为NULL, 则表示要建立一个新的现场
  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;
{IE用来指定浏览栏的标志符以及视图模式。
IE还可能填写DESKBANDINFO结构的dwMask成员从浏览栏请求更多的信息，
这个结构用第三个参数传递。GetBandInfo应该存储这个标示符和视图模式
并用所请求的数据填写DESKBANDINFO结构。下面是本文浏览栏例子所实现GetBandInfo：}
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.