ieunit.~pas

Delphi编写 IE搜索工具条 应用bho技术

unit IEUnit;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Forms, Windows, ActiveX, Classes, ComObj, SgBar_TLB, StdVcl,
  Registry, Shlobj, ShDocVW, Main;

type
  TIE_SgBar = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit, IIE_SgBar)
  private
    FrmIE: TFrmMain;
    m_pSite: IInputObjectSite;
    m_hwndParent: HWND;
    m_hWnd: HWND;
    //m_dwViewMode: Integer;
    //m_dwBandID: Integer;
  protected
  public
    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
  //以下是系统接口的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 = 300;
  MIN_SIZE_Y = 22;
  EB_CLASS_NAME = 'SoftYes工具栏';


implementation

uses ComServ;

function TIE_SgBar.GetWindow(out wnd: HWND): HResult; stdcall;
begin
  wnd := m_hWnd;
  Result := S_OK;
end;

function TIE_SgBar.ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TIE_SgBar.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 TIE_SgBar.CloseDW(dwReserved: DWORD): HResult; stdcall;
begin
  if FrmIE <> nil then
    FrmIE.Destroy;
  Result := S_OK;
end;

function TIE_SgBar.ResizeBorderDW(var prcBorder: TRect;
  punkToolbarSite: IUnknown; fReserved: BOOL): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TIE_SgBar.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 := TFrmMain.CreateParented(m_hwndParent);
      m_hWnd := FrmIE.Handle;
      application.Handle := m_hwndParent;
      SetWindowLong(m_hWnd, GWL_STYLE, GetWindowLong(m_hWnd, 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
        pSP.QueryService(IWebbrowserApp, IWebbrowser2, FrmIE.IEThis);
    end;
  end;

  Result := S_OK;
end;

function TIE_SgBar.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 TIE_SgBar.GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
  HResult; stdcall;
begin
  Result := E_INVALIDARG;
  if not Assigned(FrmIE) then FrmIE := TFrmMain.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 TIE_SgBar.GetClassID(out ClassID: TCLSID): HResult; stdcall;
begin
  ClassID := CLASS_IE_SgBar;
  Result := S_OK;
end;

function TIE_SgBar.IsDirty: HResult; stdcall;
begin
  Result := S_FALSE;
end;

function TIE_SgBar.InitNew: HResult;
begin
  Result := E_NOTIMPL;
end;

function TIE_SgBar.Load(const stm: IStream): HResult; stdcall;
begin
  Result := S_OK;
end;

function TIE_SgBar.Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
begin
  Result := S_OK;
end;

function TIE_SgBar.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;
  BSize: Integer;
begin
  inherited UpdateRegistry(Register);
  if Register then
  begin
    ClassID := GUIDToString(CLASS_IE_SgBar);
    with TRegistry.Create do
    try
      //添加附加的注册表项
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar', False) then
      begin
        BSize := 0;
        WriteBinaryData(ClassID, BSize, 0);
        CloseKey;
      end;
      if OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True) then
      begin
        WriteString(ClassID, EB_CLASS_NAME);
        CloseKey;
      end;
      RootKey := HKEY_CLASSES_ROOT;
      if OpenKey('\CLSID\' + ClassID, False) then
      begin
        WriteString('', EB_CLASS_NAME);
        CloseKey;
      end;
    finally
      Free;
    end;
  end
  else
  begin
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar', False) then
      begin
        DeleteValue(GUIDToString(CLASS_IE_SgBar));
        CloseKey;
      end;
      if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', False) then
      begin
        DeleteValue(GUIDToString(CLASS_IE_SgBar));
        CloseKey;
      end;
    finally
      Free;
    end;
  end;
end;

initialization
  TIEClassFac.Create(ComServer, TIE_SgBar, CLASS_IE_SgBar,
    'SgBar', '', ciMultiInstance, tmApartment);
end.