先说下参考的资料:
- 主要代码参考 http://mailysf.blog.zj.com/d-143742.html 。是这个博客写的示例为主干。但我在win7(64bit) + IE9下无效,所以参考其他代码做了改动,就成功了。
- 陈省的博客 http://delphi.sharpplus.com/Delphi/delphi_ie_band.htm 对整个delphi开发IE Toolbar和BHO都有所论述,很不错。
- 真正解决问题的代码来自于MS, http://support.microsoft.com/kb/196339/en-us 可以下载C++的源码。文章中也说得按键无效的实质问题所在:
Whenever a key is pressed, three things occur:In order to alleviate these problems, WebBand implements IOleControlSite. In the IOleControlSite::OnFocus method, the WebBrowser's IInputObjectSite::OnFocusChangesIS must be called to tell the WebBrowser that WebBand now has the focus.
- WebBand's IInputObject::HasFocusIO method is called to see if WebBand currently has the focus.
- The IInputObject::UIActivateIO method is called to tell WebBand that is being activated.
- The IInputObject::TranslateAccelerator method is called. It is here that WebBand passes the keystroke to the hosted WebBrowser control. This causes accelerator keys such as backspace and delete to be processed.
下面代码主要都是资料1中的,只是IInputObject::HasFocusIO的实现做了改变。
unit UTestTextBox;
interface
uses
Windows, ActiveX, Classes, ComObj, MSHTML, SHDocVw, ShellAPI, TlHelp32,
ShlObj, uIEBar, Dialogs,
Registry, Messages;
type
TTestTextBoxFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
TTestTextBox = class(TComObject, IDeskBand, IObjectWithSite,
IPersistStreamInit, IInputObject)
private
HasFocus: Boolean;
frmIE: TfrmIEBar;
m_pSite: IInputObjectSite;
m_hwndParent: HWND;
m_hWnd: HWND;
m_dwViewMode: Integer;
m_dwBandID: Integer;
m_pBrowseOC: IWebBrowser2;
SavedWndProc: TWndMethod;
protected
procedure FocusChange(bHasFocus: Boolean);
procedure BandWndProc(var Message: TMessage);
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;
{ Declare IInputObject methods here }
function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;
function HasFocusIO: HResult; stdcall;
function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;
end;
const
Class_TestTextBox: TGUID = '{9FC0A716-35A4-4ACB-8565-EAA1C2D9E0A1}';
// 以下是系统接口的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 = 23;
EB_CLASS_NAME = 'BackSpace有效性测试';
implementation
uses ComServ;
{ TTestTextBoxFactory }
procedure TTestTextBoxFactory.UpdateRegistry(Register: Boolean);
var
classID: string;
a: Integer;
begin
inherited UpdateRegistry(Register);
if Register then
begin
classID := GUIDToString(Class_TestTextBox);
with TRegistry.Create do
begin
try
// 添加附加的注册表项
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar', False);
a := 0;
WriteBinaryData(GUIDToString(Class_TestTextBox), a, 0);
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',
True);
WriteString(GUIDToString(Class_TestTextBox), EB_CLASS_NAME);
RootKey := HKEY_CLASSES_ROOT;
OpenKey('\CLSID\' + GUIDToString(Class_TestTextBox), False);
WriteString('', EB_CLASS_NAME);
finally
Free;
end;
end;
end
else
begin
with TRegistry.Create do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar', False);
DeleteValue(GUIDToString(Class_TestTextBox));
OpenKey('\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',
False);
DeleteValue(GUIDToString(Class_TestTextBox));
finally
Free;
end;
end;
end;
end;
{ TTestTextBox }
procedure TTestTextBox.BandWndProc(var Message: TMessage);
begin
if (Message.Msg = WM_PARENTNOTIFY) then
begin
HasFocus := True;
FocusChange(HasFocus);
end;
SavedWndProc(Message);
end;
function TTestTextBox.CloseDW(dwReserved: DWORD): HResult;
begin
if Assigned(frmIE) then
begin
frmIE.Free;
frmIE := nil;
end;
Result := S_OK;
end;
function TTestTextBox.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
procedure TTestTextBox.FocusChange(bHasFocus: Boolean);
begin
if m_pSite <> nil then
m_pSite.OnFocusChangeIS(Self, bHasFocus);
end;
function TTestTextBox.GetBandInfo(dwBandID, dwViewMode: DWORD;
var pdbi: TDeskBandInfo): HResult;
begin
Result := E_INVALIDARG;
if not Assigned(frmIE) then
frmIE := TfrmIEBar.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 TTestTextBox.GetClassID(out classID: TCLSID): HResult;
begin
classID := Class_TestTextBox;
Result := S_OK;
end;
function TTestTextBox.GetSite(const riid: TIID; out site: IInterface): HResult;
begin
if Assigned(m_pSite) then
Result := m_pSite.QueryInterface(riid, site)
else
Result := E_FAIL;
end;
function TTestTextBox.GetSizeMax(out cbSize: Largeint): HResult;
begin
Result := E_NOTIMPL;
end;
function TTestTextBox.GetWindow(out wnd: HWND): HResult;
begin
wnd := frmIE.Handle;
SavedWndProc := frmIE.WindowProc;
frmIE.WindowProc := BandWndProc;
Result := S_OK;
end;
function TTestTextBox.HasFocusIO: HResult;
var
hwndCur, hwndTmp: HWND;
begin
hwndCur := GetFocus;
hwndTmp := frmIE.Handle;
while (hwndCur <> 0) and (hwndTmp <> 0) do
begin
if (hwndCur = hwndTmp) then
begin
Result := S_OK;
exit;
end;
hwndTmp := Windows.GetWindow(hwndTmp, GW_CHILD);
end;
Result := S_FALSE;
end;
function TTestTextBox.InitNew: HResult;
begin
Result := E_NOTIMPL;
end;
function TTestTextBox.IsDirty: HResult;
begin
Result := S_FALSE;
end;
function TTestTextBox.Load(const stm: IStream): HResult;
begin
Result := S_OK;
end;
function TTestTextBox.ResizeBorderDW(var prcBorder: TRect;
punkToolbarSite: IInterface; fReserved: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
function TTestTextBox.Save(const stm: IStream; fClearDirty: BOOL): HResult;
begin
Result := S_OK;
end;
function TTestTextBox.SetSite(const pUnkSite: IInterface): HResult;
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 := TfrmIEBar.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 TTestTextBox.ShowDW(fShow: BOOL): HResult;
begin
HasFocus := fShow;
FocusChange(HasFocus);
Result := S_OK;
end;
function TTestTextBox.TranslateAcceleratorIO(var lpMsg: TMsg): HResult;
begin
if (lpMsg.wParam <> VK_TAB) then
begin
TranslateMessage(lpMsg);
DispatchMessage(lpMsg);
Result := S_OK;
end
else
begin
Result := S_FALSE;
end;
end;
function TTestTextBox.UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult;
begin
HasFocus := fActivate;
if HasFocus then
frmIE.SetFocus;
Result := S_OK;
end;
initialization
TTestTextBoxFactory.Create(ComServer, TTestTextBox, Class_TestTextBox,
'BackSpace有效性测试', '测试输入框中的BackSpace', ciMultiInstance, tmApartment);
end.
unit uIEBar;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, SHDocVw;
type
TfrmIEBar = class(TForm)
TxtUrl: TEdit;
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
IEThis: IWebbrowser2;
end;
var
frmIE: TfrmIEBar;
implementation
{$R *.dfm}
procedure TfrmIEBar.FormActivate(Sender: TObject);
begin
TxtUrl.SetFocus;
end;
end.