IE toolbar , backspace

Delphi 开发IE Toolbar，解决Backspace按键问题

分类： Delphi2011-08-29 13:59 283人阅读 评论(0) 收藏 举报

先说下参考的资料：

1. 主要代码参考 http://mailysf.blog.zj.com/d-143742.html 。是这个博客写的示例为主干。但我在win7（64bit） + IE9下无效，所以参考其他代码做了改动，就成功了。
2. 陈省的博客 http://delphi.sharpplus.com/Delphi/delphi_ie_band.htm 对整个delphi开发IE Toolbar和BHO都有所论述，很不错。
3. 真正解决问题的代码来自于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. 

1. WebBand's IInputObject::HasFocusIO method is called to see if WebBand currently has the focus.
2. The IInputObject::UIActivateIO method is called to tell WebBand that is being activated.
3. 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的实现做了改变。

[delphi] view plaincopy

1. unit UTestTextBox;  
2.   
3. interface  
4.   
5. uses  
6.   Windows, ActiveX, Classes, ComObj, MSHTML, SHDocVw, ShellAPI, TlHelp32,  
7.   ShlObj, uIEBar, Dialogs,  
8.   Registry, Messages;  
9.   
10. type  
11.   TTestTextBoxFactory = class(TComObjectFactory)  
12.   public  
13.     procedure UpdateRegistry(Register: Boolean); override;  
14.   end;  
15.   
16.   TTestTextBox = class(TComObject, IDeskBand, IObjectWithSite,  
17.     IPersistStreamInit, IInputObject)  
18.   private  
19.     HasFocus: Boolean;  
20.     frmIE: TfrmIEBar;  
21.     m_pSite: IInputObjectSite;  
22.     m_hwndParent: HWND;  
23.     m_hWnd: HWND;  
24.     m_dwViewMode: Integer;  
25.     m_dwBandID: Integer;  
26.     m_pBrowseOC: IWebBrowser2;  
27.     SavedWndProc: TWndMethod;  
28.   protected  
29.     procedure FocusChange(bHasFocus: Boolean);  
30.     procedure BandWndProc(var Message: TMessage);  
31.   public  
32.     { Declare IDeskBand methods here }  
33.     function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo)  
34.       : HResult; stdcall;  
35.     function ShowDW(fShow: BOOL): HResult; stdcall;  
36.     function CloseDW(dwReserved: DWORD): HResult; stdcall;  
37.     function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;  
38.       fReserved: BOOL): HResult; stdcall;  
39.     function GetWindow(out wnd: HWND): HResult; stdcall;  
40.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;  
41.   
42.     { Declare IObjectWithSite methods here }  
43.     function SetSite(const pUnkSite: IUnknown): HResult; stdcall;  
44.     function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;  
45.   
46.     { Declare IPersistStream methods here }  
47.     function GetClassID(out classID: TCLSID): HResult; stdcall;  
48.     function IsDirty: HResult; stdcall;  
49.     function InitNew: HResult; stdcall;  
50.     function Load(const stm: IStream): HResult; stdcall;  
51.     function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;  
52.     function GetSizeMax(out cbSize: Largeint): HResult; stdcall;  
53.     { Declare IInputObject methods here }  
54.     function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;  
55.     function HasFocusIO: HResult; stdcall;  
56.     function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;  
57.   end;  
58.   
59. const  
60.   Class_TestTextBox: TGUID = '{9FC0A716-35A4-4ACB-8565-EAA1C2D9E0A1}';  
61.   // 以下是系统接口的IID  
62.   IID_IUnknown: TGUID = (D1: $00000000; D2: $0000; D3: $0000;  
63.     D4: ($C0, $00, $00, $00, $00, $00, $00, $46));  
64.   IID_IOleObject: TGUID = (D1: $00000112; D2: $0000; D3: $0000;  
65.     D4: ($C0, $00, $00, $00, $00, $00, $00, $46));  
66.   IID_IOleWindow: TGUID = (D1: $00000114; D2: $0000; D3: $0000;  
67.     D4: ($C0, $00, $00, $00, $00, $00, $00, $46));  
68.   
69.   IID_IInputObjectSite: TGUID = (D1: $F1DB8392; D2: $7331; D3: $11D0;  
70.     D4: ($8C, $99, $00, $A0, $C9, $2D, $BF, $E8));  
71.   sSID_SInternetExplorer: TGUID = '{0002DF05-0000-0000-C000-000000000046}';  
72.   sIID_IWebBrowserApp: TGUID = '{0002DF05-0000-0000-C000-000000000046}';  
73.   
74.   // 面板所允许的最小宽度和高度。  
75.   MIN_SIZE_X = 54;  
76.   MIN_SIZE_Y = 23;  
77.   EB_CLASS_NAME = 'BackSpace有效性测试';  
78.   
79. implementation  
80.   
81. uses ComServ;  
82.   
83. { TTestTextBoxFactory }  
84.   
85. procedure TTestTextBoxFactory.UpdateRegistry(Register: Boolean);  
86. var  
87.   classID: string;  
88.   a: Integer;  
89. begin  
90.   inherited UpdateRegistry(Register);  
91.   if Register then  
92.   begin  
93.     classID := GUIDToString(Class_TestTextBox);  
94.     with TRegistry.Create do  
95.     begin  
96.       try  
97.         // 添加附加的注册表项  
98.         RootKey := HKEY_LOCAL_MACHINE;  
99.         OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar', False);  
100.         a := 0;  
101.         WriteBinaryData(GUIDToString(Class_TestTextBox), a, 0);  
102.         OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',  
103.           True);  
104.         WriteString(GUIDToString(Class_TestTextBox), EB_CLASS_NAME);  
105.         RootKey := HKEY_CLASSES_ROOT;  
106.         OpenKey('\CLSID\' + GUIDToString(Class_TestTextBox), False);  
107.         WriteString('', EB_CLASS_NAME);  
108.       finally  
109.         Free;  
110.       end;  
111.     end;  
112.   end  
113.   else  
114.   begin  
115.     with TRegistry.Create do  
116.     begin  
117.       try  
118.         RootKey := HKEY_LOCAL_MACHINE;  
119.         OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar', False);  
120.         DeleteValue(GUIDToString(Class_TestTextBox));  
121.         OpenKey('\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',  
122.           False);  
123.         DeleteValue(GUIDToString(Class_TestTextBox));  
124.       finally  
125.         Free;  
126.       end;  
127.     end;  
128.   end;  
129. end;  
130.   
131. { TTestTextBox }  
132.   
133. procedure TTestTextBox.BandWndProc(var Message: TMessage);  
134. begin  
135.   if (Message.Msg = WM_PARENTNOTIFY) then  
136.   begin  
137.     HasFocus := True;  
138.     FocusChange(HasFocus);  
139.   end;  
140.   SavedWndProc(Message);  
141. end;  
142.   
143. function TTestTextBox.CloseDW(dwReserved: DWORD): HResult;  
144. begin  
145.   if Assigned(frmIE) then  
146.   begin  
147.     frmIE.Free;  
148.     frmIE := nil;  
149.   end;  
150.   Result := S_OK;  
151. end;  
152.   
153. function TTestTextBox.ContextSensitiveHelp(fEnterMode: BOOL): HResult;  
154. begin  
155.   Result := E_NOTIMPL;  
156. end;  
157.   
158. procedure TTestTextBox.FocusChange(bHasFocus: Boolean);  
159. begin  
160.   if m_pSite <> nil then  
161.     m_pSite.OnFocusChangeIS(Self, bHasFocus);  
162. end;  
163.   
164. function TTestTextBox.GetBandInfo(dwBandID, dwViewMode: DWORD;  
165.   var pdbi: TDeskBandInfo): HResult;  
166. begin  
167.   Result := E_INVALIDARG;  
168.   if not Assigned(frmIE) then  
169.     frmIE := TfrmIEBar.CreateParented(m_hwndParent);  
170.   if (@pdbi <> nil) then  
171.   begin  
172.     m_dwBandID := dwBandID;  
173.     m_dwViewMode := dwViewMode;  
174.     if (pdbi.dwMask and DBIM_MINSIZE) <> 0 then  
175.     begin  
176.       pdbi.ptMinSize.x := MIN_SIZE_X;  
177.       pdbi.ptMinSize.y := MIN_SIZE_Y;  
178.     end;  
179.     if (pdbi.dwMask and DBIM_MAXSIZE) <> 0 then  
180.     begin  
181.       pdbi.ptMaxSize.x := -1;  
182.       pdbi.ptMaxSize.y := -1;  
183.     end;  
184.     if (pdbi.dwMask and DBIM_INTEGRAL) <> 0 then  
185.     begin  
186.       pdbi.ptIntegral.x := 1;  
187.       pdbi.ptIntegral.y := 1;  
188.     end;  
189.     if (pdbi.dwMask and DBIM_ACTUAL) <> 0 then  
190.     begin  
191.       pdbi.ptActual.x := 0;  
192.       pdbi.ptActual.y := 0;  
193.     end;  
194.     if (pdbi.dwMask and DBIM_MODEFLAGS) <> 0 then  
195.       pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT;  
196.     if (pdbi.dwMask and DBIM_BKCOLOR) <> 0 then  
197.       pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR);  
198.   end;  
199. end;  
200.   
201. function TTestTextBox.GetClassID(out classID: TCLSID): HResult;  
202. begin  
203.   classID := Class_TestTextBox;  
204.   Result := S_OK;  
205. end;  
206.   
207. function TTestTextBox.GetSite(const riid: TIID; out site: IInterface): HResult;  
208. begin  
209.   if Assigned(m_pSite) then  
210.     Result := m_pSite.QueryInterface(riid, site)  
211.   else  
212.     Result := E_FAIL;  
213. end;  
214.   
215. function TTestTextBox.GetSizeMax(out cbSize: Largeint): HResult;  
216. begin  
217.   Result := E_NOTIMPL;  
218. end;  
219.   
220. function TTestTextBox.GetWindow(out wnd: HWND): HResult;  
221. begin  
222.   wnd := frmIE.Handle;  
223.   SavedWndProc := frmIE.WindowProc;  
224.   frmIE.WindowProc := BandWndProc;  
225.   Result := S_OK;  
226. end;  
227.   
228. function TTestTextBox.HasFocusIO: HResult;  
229. var  
230.   hwndCur, hwndTmp: HWND;  
231. begin  
232.   hwndCur := GetFocus;  
233.   hwndTmp := frmIE.Handle;  
234.   while (hwndCur <> 0) and (hwndTmp <> 0) do  
235.   begin  
236.     if (hwndCur = hwndTmp) then  
237.     begin  
238.       Result := S_OK;  
239.       exit;  
240.     end;  
241.     hwndTmp := Windows.GetWindow(hwndTmp, GW_CHILD);  
242.   end;  
243.   
244.   Result := S_FALSE;  
245. end;  
246.   
247. function TTestTextBox.InitNew: HResult;  
248. begin  
249.   Result := E_NOTIMPL;  
250. end;  
251.   
252. function TTestTextBox.IsDirty: HResult;  
253. begin  
254.   Result := S_FALSE;  
255. end;  
256.   
257. function TTestTextBox.Load(const stm: IStream): HResult;  
258. begin  
259.   Result := S_OK;  
260. end;  
261.   
262. function TTestTextBox.ResizeBorderDW(var prcBorder: TRect;  
263.   punkToolbarSite: IInterface; fReserved: BOOL): HResult;  
264. begin  
265.   Result := E_NOTIMPL;  
266. end;  
267.   
268. function TTestTextBox.Save(const stm: IStream; fClearDirty: BOOL): HResult;  
269. begin  
270.   Result := S_OK;  
271. end;  
272.   
273. function TTestTextBox.SetSite(const pUnkSite: IInterface): HResult;  
274. var  
275.   pOleWindow: IOleWindow;  
276.   pOLEcmd: IOleCommandTarget;  
277.   pSP: IServiceProvider;  
278.   rc: TRect;  
279. begin  
280.   if Assigned(pUnkSite) then  
281.   begin  
282.     m_hwndParent := 0;  
283.     m_pSite := pUnkSite as IInputObjectSite;  
284.     pOleWindow := pUnkSite as IOleWindow;  
285.     // 获得父窗口IE面板窗口的句柄  
286.     pOleWindow.GetWindow(m_hwndParent);  
287.     if (m_hwndParent = 0) then  
288.     begin  
289.       Result := E_FAIL;  
290.       exit;  
291.     end;  
292.     // 获得父窗口区域  
293.     GetClientRect(m_hwndParent, rc);  
294.     if not Assigned(frmIE) then  
295.     begin  
296.       // 建立TIEForm窗口，父窗口为m_hwndParent  
297.       frmIE := TfrmIEBar.CreateParented(m_hwndParent);  
298.       m_hWnd := frmIE.Handle;  
299.       SetWindowLong(frmIE.Handle, GWL_STYLE, GetWindowLong(frmIE.Handle,  
300.         GWL_STYLE) Or WS_CHILD);  
301.       // 根据父窗口区域设置窗口位置  
302.       with frmIE do  
303.       begin  
304.         Left := rc.Left;  
305.         Top := rc.Top;  
306.         Width := rc.Right - rc.Left;  
307.         Height := rc.Bottom - rc.Top;  
308.       end;  
309.       frmIE.Visible := True;  
310.       // 获得与浏览器相关联的Webbrowser对象。  
311.       pOLEcmd := pUnkSite as IOleCommandTarget;  
312.       pSP := pOLEcmd as IServiceProvider;  
313.       if Assigned(pSP) then  
314.       begin  
315.         pSP.QueryService(IWebbrowserApp, IWebBrowser2, frmIE.IEThis);  
316.       end;  
317.     end;  
318.   end;  
319.   Result := S_OK;  
320. end;  
321.   
322. function TTestTextBox.ShowDW(fShow: BOOL): HResult;  
323. begin  
324.   HasFocus := fShow;  
325.   FocusChange(HasFocus);  
326.   Result := S_OK;  
327. end;  
328.   
329. function TTestTextBox.TranslateAcceleratorIO(var lpMsg: TMsg): HResult;  
330. begin  
331.   if (lpMsg.wParam <> VK_TAB) then  
332.   begin  
333.     TranslateMessage(lpMsg);  
334.     DispatchMessage(lpMsg);  
335.     Result := S_OK;  
336.   end  
337.   else  
338.   begin  
339.     Result := S_FALSE;  
340.   end;  
341. end;  
342.   
343. function TTestTextBox.UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult;  
344. begin  
345.   HasFocus := fActivate;  
346.   if HasFocus then  
347.     frmIE.SetFocus;  
348.   Result := S_OK;  
349. end;  
350.   
351. initialization  
352.   
353. TTestTextBoxFactory.Create(ComServer, TTestTextBox, Class_TestTextBox,  
354.   'BackSpace有效性测试', '测试输入框中的BackSpace', ciMultiInstance, tmApartment);  
355.   
356. end.  

[delphi] view plaincopy

1. unit uIEBar;  
2.   
3. interface  
4.   
5. uses  
6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
7.   Dialogs, StdCtrls, SHDocVw;  
8.   
9. type  
10.   TfrmIEBar = class(TForm)  
11.     TxtUrl: TEdit;  
12.     procedure FormActivate(Sender: TObject);  
13.   private  
14.     { Private declarations }  
15.   public  
16.     { Public declarations }  
17.     IEThis: IWebbrowser2;  
18.   end;  
19.   
20. var  
21.   frmIE: TfrmIEBar;  
22.   
23. implementation  
24.   
25. {$R *.dfm}  
26.   
27. procedure TfrmIEBar.FormActivate(Sender: TObject);  
28. begin  
29.   TxtUrl.SetFocus;  
30. end;  
31.   
32. end.