如何在IE的工具栏上添加自己的按钮？十万火急，在线等待。

Question

1.main.pas
==========================================================================
unit main;interfaceuses
Windows, ActiveX, ComObj, ShlObj, Bar, SHDocVw;Type
TBarType=(btInfo,btDesk,btComm,btToolbar);const
BarName='测试工具栏';
BarType=btToolbar;
MIN_SIZE_X=80;
MIN_SIZE_Y=24;
Class_IEBar: TGUID = '{222CCD87-2240-11D4-97C2-0000E8974CF6}';
IID_IOleWindow:TGUID='{00000114-0000-0000-C000-000000000046}';
IID_IInputObjectSite:TGUID=SID_IInputObjectSite;
SID_Extension='{7C4A7901-224E-11D4-97C2-0000E8974CF6}';
CATID_DeskBand:TGUID=(D1:$00021492; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CATID_InfoBand:TGUID=(D1:$00021493; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CATID_CommBand:TGUID=(D1:$00021494; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));type
TIEBar = Class(TComObject,IDeskBand,IObjectWithSite,IPersistStream)
private
FBandID:DWORD;
FViewMode:DWORD;
    Site: IInputObjectSite;
    cmdTarget: IOleCommandTarget;IE:IWebBrowser2;
ParentWnd:HWnd;
frmBar: TfrmBar;
protected
//IDeskBand = interface(IDockingWindow)[SID_IDeskBand]
function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):HResult; stdcall;//IDockingWindow = interface(IOleWindow)[SID_IDockingWindow]
function ShowDW(fShow: BOOL): HResult; stdcall;
function CloseDW(dwReserved: DWORD): HResult; stdcall;
function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;fReserved: BOOL): HResult; stdcall;//IOleWindow = interface(IUnknown)['{00000114-0000-0000-C000-000000000046}']
function GetWindow(out wnd: HWnd): HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;//IObjectWithSite = interface ['{FC4801A3-2BA9-11CF-A229-00AA003D7352}']
function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown):HResult; stdcall;//IPersistStream = interface(IPersist) ['{00000109-0000-0000-C000-000000000046}']
function IsDirty: 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;//IPersist = interface(IUnknown)['{0000010C-0000-0000-C000-000000000046}']
function GetClassID(out classID: TCLSID): HResult; stdcall;//IInputObject = interface(IUnknown) [SID_IInputObject]
function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;
function HasFocusIO: HResult; stdcall;
function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;
public
//TComObject
procedure Initialize; Override;
end;implementationuses ComServ, SysUtils, ShellApi, registry;{$R BarIcon.res}
{ TIEBar }function TIEBar.CloseDW(dwReserved: DWORD): HResult;
begin
if Assigned(frmBar) then
begin
frmBar.Free;
frmBar := nil;
end;
Result := S_OK;
end;function TIEBar.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result := S_OK;
end;function TIEBar.GetBandInfo(dwBandID, dwViewMode: DWORD;
var pdbi: TDeskBandInfo): HResult;
begin
FBandID := dwBandID;
FViewMode := 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;Result := S_OK;
end;function TIEBar.GetClassID(out classID: TCLSID): HResult;
begin
classID := Class_IEBar;
Result := S_OK;
end;function TIEBar.GetSite(const riid: TIID; out site: IUnknown): HResult;
begin
if Assigned(Site) then
Result := Site.QueryInterface(riid, site)
else
Result := E_FAIL;
end;function TIEBar.GetSizeMax(out cbSize: Largeint): HResult;
begin
cbSize := 0;
Result := E_NOTIMPL;
end;function TIEBar.GetWindow(out wnd: HWnd): HResult;
begin
if not Assigned(frmBar) then
  begin
  frmBar := TfrmBar.CreateParented(ParentWnd);
    frmBar.WebBrow := IE;
  end;
  wnd := frmBar.Handle;
Result := S_OK;
end;

Answer 1

function TIEBar.HasFocusIO: HResult;
begin
if Assigned(frmBar) and (frmBar.Active) then
Result := S_OK
else
Result := E_FAIL;
end;procedure TIEBar.Initialize;
begin
inherited;
Site := nil;
IE := nil;
ParentWnd := 0;
frmBar := nil;
end;function TIEBar.IsDirty: HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.Load(const stm: IStream): HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.ResizeBorderDW(var prcBorder: TRect;
punkToolbarSite: IUnknown; fReserved: BOOL): HResult;
var
rc:TRect;
begin
if Assigned(frmBar) then
begin
GetClientRect(ParentWnd, rc);
frmBar.SetBounds(rc.Left,rc.Top,rc.Right-rc.Left,rc.Bottom-rc.Top);
end;
Result := S_OK;
end;function TIEBar.Save(const stm: IStream; fClearDirty: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.SetSite(const pUnkSite: IUnknown): HResult;
begin
  if Assigned(pUnkSite) then begin
    Site := pUnkSite as IInputObjectSite;
    (pUnkSite as IOleWindow).GetWindow(ParentWnd);
    cmdTarget := pUnkSite as IOleCommandTarget;
    (CmdTarget as IServiceProvider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
  end;
  Result := S_OK;
end;function TIEBar.ShowDW(fShow: BOOL): HResult;
begin
if Assigned(frmBar) then frmBar.Visible := fShow;
Result := S_OK;
end;{TIEBarFactory}
type
TIEBarFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;function GetModuleFileName: string;
var
Buffer: array[0..261] of Char;
begin
SetString(Result, Buffer, Windows.GetModuleFileName(HInstance,
Buffer, SizeOf(Buffer)));
end;procedure TIEBarFactory.UpdateRegistry(Register: Boolean);
var
ClassID,CatClassID: string;
begin
ClassID := GUIDToString(Class_IEBar);
case BarType of
btInfo:CatClassID:=GUIDToString(CATID_InfoBand);
btComm:CatClassID:=GUIDToString(CATID_CommBand);
btDesk:CatClassID:=GUIDToString(CATID_DeskBand);
btToolbar:CatClassID:=GUIDToString(CATID_CommBand);
end;
if Register then begin
inherited UpdateRegistry(Register);
CreateRegKey('CLSID\'+ClassID+'\Implemented Categories','','');
CreateRegKey('CLSID\'+ClassID+'\Implemented Categories\'+CatClassID,'','');
if BarType=btToolbar then begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey('SOFTWARE\Microsoft\Internet Explorer',False) then Exit;
CloseKey;
OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar',True);
WriteString(ClassID,'');
CloseKey;
finally
Free;
end;
end;
end else begin
DeleteRegKey('CLSID\'+ClassID+'\Implemented Categories\'+CatClassID);
DeleteRegKey('CLSID\'+ClassID+'\Implemented Categories');
if BarType=btToolbar then begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
DeleteValue(ClassID);
CloseKey;
finally
Free;
end;
end;
inherited UpdateRegistry(Register);
end;
end;
function TIEBar.TranslateAcceleratorIO(var lpMsg: TMsg): HResult;
begin
  if (lpMsg.WParam <> VK_TAB) then begin
    TranslateMessage(lpMSg);
    DispatchMessage(lpMsg);
    Result := S_OK;
  end
  else Result := S_FALSE;
end;function TIEBar.UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult;
begin
if Assigned(frmBar) and fActivate then SetFocus(frmBar.Handle);
Result := S_OK;
end;initialization
TIEBarFactory.Create(ComServer, TIEBar, Class_IEBar,'', BarName,
ciMultiInstance,tmApartment);
end.2.bar.pas
===============================================================================
unit Bar;interfaceuses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, graphics, OleCtrls, SHDocVw, fcImage,
  fcImageForm, Menus;type
TfrmBar = class(TForm)
btnStart: TSpeedButton;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
img:TImage;
procedure NavigateFromBand(const URL: string);
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
public
{ Public declarations }
WebBrow:IWebBrowser2;
end;
implementation{$R *.DFM}{ TfrmBar }procedure TfrmBar.btnStartClick(Sender: TObject);
begin
NavigateFromBand(edit1.text);
end;procedure TfrmBar.NavigateFromBand(const URL: string);
var
  _url: OleVariant;
  X: OleVariant;
begin
  _Url := Url;
  X := 0;
  WebBrow.Navigate(Url, X, X, X, X);
end;
procedure TfrmBar.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var
  Rec,Rec1:TRect;
begin
  img.Picture.Bitmap.Width := Left + Width;
  img.Picture.Bitmap.Height := Top + Height;
  img.Visible := True;
  SendMessage(ParentWindow,WM_ERASEBKGND,img.Canvas.Handle,0);
GetUpdateRect(Handle,Rec,True);
  Rec1.Left := Rec.Left + Left;
  Rec1.Top  := Rec.Top  + Top;
  Rec1.Right  := Rec.Right  + Left;
  Rec1.Bottom := Rec.Bottom + Top;
  Canvas.CopyRect(Rec,img.Canvas,Rec1);
  Message.Result := 0;
end;procedure TfrmBar.FormCreate(Sender: TObject);
begin
img := TImage.Create(Self);
end;procedure TfrmBar.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  img.Picture.Bitmap.Free;
  img.Picture.Bitmap := nil;
img.Free;
end;
end. 

Answer 2

function TIEBar.HasFocusIO: HResult;
begin
if Assigned(frmBar) and (frmBar.Active) then
Result := S_OK
else
Result := E_FAIL;
end;procedure TIEBar.Initialize;
begin
inherited;
Site := nil;
IE := nil;
ParentWnd := 0;
frmBar := nil;
end;function TIEBar.IsDirty: HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.Load(const stm: IStream): HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.ResizeBorderDW(var prcBorder: TRect;
punkToolbarSite: IUnknown; fReserved: BOOL): HResult;
var
rc:TRect;
begin
if Assigned(frmBar) then
begin
GetClientRect(ParentWnd, rc);
frmBar.SetBounds(rc.Left,rc.Top,rc.Right-rc.Left,rc.Bottom-rc.Top);
end;
Result := S_OK;
end;function TIEBar.Save(const stm: IStream; fClearDirty: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;function TIEBar.SetSite(const pUnkSite: IUnknown): HResult;
begin
  if Assigned(pUnkSite) then begin
    Site := pUnkSite as IInputObjectSite;
    (pUnkSite as IOleWindow).GetWindow(ParentWnd);
    cmdTarget := pUnkSite as IOleCommandTarget;
    (CmdTarget as IServiceProvider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
  end;
  Result := S_OK;
end;function TIEBar.ShowDW(fShow: BOOL): HResult;
begin
if Assigned(frmBar) then frmBar.Visible := fShow;
Result := S_OK;
end;{TIEBarFactory}
type
TIEBarFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;function GetModuleFileName: string;
var
Buffer: array[0..261] of Char;
begin
SetString(Result, Buffer, Windows.GetModuleFileName(HInstance,
Buffer, SizeOf(Buffer)));
end;procedure TIEBarFactory.UpdateRegistry(Register: Boolean);
var
ClassID,CatClassID: string;
begin
ClassID := GUIDToString(Class_IEBar);
case BarType of
btInfo:CatClassID:=GUIDToString(CATID_InfoBand);
btComm:CatClassID:=GUIDToString(CATID_CommBand);
btDesk:CatClassID:=GUIDToString(CATID_DeskBand);
btToolbar:CatClassID:=GUIDToString(CATID_CommBand);
end;
if Register then begin
inherited UpdateRegistry(Register);
CreateRegKey('CLSID\'+ClassID+'\Implemented Categories','','');
CreateRegKey('CLSID\'+ClassID+'\Implemented Categories\'+CatClassID,'','');
if BarType=btToolbar then begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey('SOFTWARE\Microsoft\Internet Explorer',False) then Exit;
CloseKey;
OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar',True);
WriteString(ClassID,'');
CloseKey;
finally
Free;
end;
end;
end else begin
DeleteRegKey('CLSID\'+ClassID+'\Implemented Categories\'+CatClassID);
DeleteRegKey('CLSID\'+ClassID+'\Implemented Categories');
if BarType=btToolbar then begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
DeleteValue(ClassID);
CloseKey;
finally
Free;
end;
end;
inherited UpdateRegistry(Register);
end;
end;
function TIEBar.TranslateAcceleratorIO(var lpMsg: TMsg): HResult;
begin
  if (lpMsg.WParam <> VK_TAB) then begin
    TranslateMessage(lpMSg);
    DispatchMessage(lpMsg);
    Result := S_OK;
  end
  else Result := S_FALSE;
end;function TIEBar.UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult;
begin
if Assigned(frmBar) and fActivate then SetFocus(frmBar.Handle);
Result := S_OK;
end;initialization
TIEBarFactory.Create(ComServer, TIEBar, Class_IEBar,'', BarName,
ciMultiInstance,tmApartment);
end.2.bar.pas
===============================================================================
unit Bar;interfaceuses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, graphics, OleCtrls, SHDocVw, fcImage,
  fcImageForm, Menus;type
TfrmBar = class(TForm)
btnStart: TSpeedButton;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
img:TImage;
procedure NavigateFromBand(const URL: string);
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
public
{ Public declarations }
WebBrow:IWebBrowser2;
end;
implementation{$R *.DFM}{ TfrmBar }procedure TfrmBar.btnStartClick(Sender: TObject);
begin
NavigateFromBand(edit1.text);
end;procedure TfrmBar.NavigateFromBand(const URL: string);
var
  _url: OleVariant;
  X: OleVariant;
begin
  _Url := Url;
  X := 0;
  WebBrow.Navigate(Url, X, X, X, X);
end;
procedure TfrmBar.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var
  Rec,Rec1:TRect;
begin
  img.Picture.Bitmap.Width := Left + Width;
  img.Picture.Bitmap.Height := Top + Height;
  img.Visible := True;
  SendMessage(ParentWindow,WM_ERASEBKGND,img.Canvas.Handle,0);
GetUpdateRect(Handle,Rec,True);
  Rec1.Left := Rec.Left + Left;
  Rec1.Top  := Rec.Top  + Top;
  Rec1.Right  := Rec.Right  + Left;
  Rec1.Bottom := Rec.Bottom + Top;
  Canvas.CopyRect(Rec,img.Canvas,Rec1);
  Message.Result := 0;
end;procedure TfrmBar.FormCreate(Sender: TObject);
begin
img := TImage.Create(Self);
end;procedure TfrmBar.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  img.Picture.Bitmap.Free;
  img.Picture.Bitmap := nil;
img.Free;
end;
end. 

Answer 3

在
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\Extensions\
下建立一个项如，
{00000111-F40A-11D1-B792-444553540001}
然后下面有这些键
"ButtonText"="青海证券"
"CLSID"="{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}"
"Default visible"="Yes"
"Exec"="C:\\Program Files\\数码股王2.0\\qzOnline.exe"
"HotIcon"="C:\\Program Files\\数码股王2.0\\qzOnline.exe,264"
"Icon"="C:\\Program Files\\数码股王2.0\\qzOnline.exe,264"
"MenuStatusBar"="青海证券数码股王"
"MenuText"="青海证券"