Embed toolbar into IE

First, we need to create an ActiveX library. Save it as mailieband. DPR; then create a COM Object and save it as bandunit. PAS; then, create a form. This window will be displayed as a sub-window in the IE Toolbar, change the borderstyle attribute of the window to bsnone, and add a tbutton component and a tcombobox component, change the tbutton caption attribute to get all, and save the window file as ieform. PAS.
In bandunit, you need to create a tcomobject object that implements the interface mentioned above. As follows:
Tgetmailband = Class (tcomobject, ideskband, iobjectwithsite, ipersiststreaminit)

In addition, because you need to add some registry information when registering the COM server, you also need to create an object inherited from the tcomobjectfactory class and write code in the updateregistry event of the object to add additional registry information.
The following program lists all program code for implementing the COM server from 1-6 to 1-8:

Program list 1-6 mailieband. DPR
Library mailieband;

Uses
Comserv,
Bandunit in 'bandunit. pa ',
Ieform in 'ieform. pa' {form1 },
Mailieband_tlb in 'mailieband _ TLB. pa ';

Exports
Dllgetclassobject,
Dllcanunloadnow,
Dllregisterserver,
Dllunregisterserver;

{$ R *. TLB}

{$ R *. Res}

Begin
End.

Program list 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 }';
// The following is the IID of the System Interface
Iid_iunknown: tguid = (
D1: $00000000; d2: $0000; D3: $0000; D4 :( $ C0, $00, $00, $00, $00, $00, $00, $00, $46 ));
Iid_ioleobject: tguid = (
D1: $00000112; d2: $0000; D3: $0000; D4 :( $ C0, $00, $00, $00, $00, $00, $00, $00, $46 ));
Iid_iolewindow: tguid = (
D1: $00000114; d2: $0000; D3: $0000; D4 :( $ C0, $00, $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 }';

// The minimum width and height allowed by the Panel.
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;
// Obtain the handle of the IE panel window of the parent window
Polewindow. getwindow (m_hwndparent );

If (m_hwndparent = 0) then begin
Result: = e_fail;
Exit;
End;

// Obtain the parent window area
Getclientrect (m_hwndparent, RC );

If not assigned (frmie) then begin
// Create a tieform window. The parent window is m_hwndparent.
Frmie: = tform1.createparented (m_hwndparent );

M_hwnd: = frmie. Handle;

Setwindowlong (frmie. Handle, gwl_style, getwindowlong (frmie. handle,
Gwl_style) or ws_child );
// Set the window position based on the parent window area
With frmie do begin
Left: = RC. Left;
Top: = RC. Top;
Width: = RC. Right-RC. Left;
Height: = RC. Bottom-RC. Top;
End;
Frmie. Visible: = true;

// Obtain the webbrowser object associated with the browser.
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;
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;

// Register COM components using the tieclassfac class
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
// Add an additional registry key
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.

Program list 1-8 ieform. Pas

Unit ieform;

Interface

Uses
Windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
Shdocvw, mshtml, stdctrls;

Type
Tform1 = Class (tform)
Button1: tbutton;
Combox1: tcombobox;
Procedure formresize (Sender: tobject );
Procedure button1click (Sender: tobject );
Private
{Private Declarations}
Public
Iethis: iwebbrowser2;
{Public declarations}
End;

VaR
Form1: tform1;

Implementation

{$ R *. DFM}

Procedure tform1.formresize (Sender: tobject );
Begin
With button1 do begin
Left: = 0;
Top: = 0;
Height: = self. clientheight;
End;
With combox1 do begin
Left: = button1.width + 3;
Top: = 0;
Height: = self. clientheight;
Width: = self. clientwidth-left;
End;
End;

Procedure tform1.button1click (Sender: tobject );
VaR
DOC: ihtmldocument2;
ALL: ihtmlelementcollection;
Len, I, flag: integer;
Item: ihtmlelement;
Vattri: variant;
Begin
If assigned (iethis) then begin
Combobox1.clear;
// Obtain the document object in the webbrowser object
DOC: = iethis. Document as ihtmldocument2;
// Obtain all HTML element sets in the document
ALL: = Doc. get_all;

Len: = all. get_length;

// Access every element in the HTML Element Set
For I: = 0 to a len-1 do begin
Item: = all. Item (I, varempty) as ihtmlelement;
// If the element is a link
If item. get_tagname = 'A' then begin
Flag: = 0;
Vattri: = item. getattribute ('protocol', flag); // get Link Attributes
// Add the target address of the link to combox1 if it is a mailto link
If vattri = 'mailto: 'then begin
Vattri: = item. getattribute ('href ', flag );
Combobox1.items. Add (vattri );
End;
End;
End;
End;
End;

End.

Compile the project, close all IE Windows, and click Run | register ActiveX Server in the Delphi menu to register the server. Open IE and click View | toolbar item. You can see that there is one more getmailaddress item in the sub-menu. Select the change item and the toolbar appears in the IE Toolbar.