如何实现ie里的自写的ToolBar类型知道自己是最后一个还活着的实例？ ( 积分: 100 )

需要在最后一个包含该Toolbar的浏览器关闭时把注册表清空。有什么好办法？试过查找iexplore.exe进程的办法，但是有些ie可能就没有开这个toolbar，而有些非ie，比如资源管理器，也可以开着这个toolbar

需要在最后一个包含该Toolbar的浏览器关闭时把注册表清空。有什么好办法？试过查找iexplore.exe进程的办法，但是有些ie可能就没有开这个toolbar，而有些非ie，比如资源管理器，也可以开着这个toolbar

往注册表中写入一个引用计数值，的每个toolbar建立时将其加一，释放时减一。

这个方案是我最初计划采用的。但是考虑到只要有一个ToolBar非正常关闭，也就是没有释放，后果就是以后永远不会达到删除条件，不管什么开机关机。所以才被迫去搜iexplore.exe进程。

当然，如果能在开机时去设置初值，关机时去处理，可能是最简便的。但这要多一个进程在跑。而且我最讨厌在开机时添加运行的东西，跟病毒似的。

toolband是COM阿，COM本身就有计数

可否给一简单例子，连接也行，英文也行。

所有COM都有引用记数的，不知道你要什么例子？


http://www.euromind.com/iedelphi/ie5tools/bandobjects.htm

贵例子里面没有用到com的计数引用。
而且这个例子有毛病，要把Shdocvw_tlb改成Shdocvw才能跑，跑出来的结果也是有bug的。

我的例子来自 《Delphi 下深入windows核心编程》一书，IE工具栏 一节。
现在想在这里面添加一个_release()来在最后一次释放时处理注册表，如何修改？
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
unit MailIEBand_TLB;

// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 2005-6-13 16:01:45 from Type Library described below.

// ************************************************************************ //
// Type Lib: D:/Delphi.Test/Test.Visible/IE工具栏/BrotherLink.tlb (1)
// LIBID: {A078612A-EA84-4115-B2C7-7AE9EDA70C1F}
// LCID: 0
// Helpfile:
// HelpString: MailIEBand Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/System32/stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;


// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
MailIEBandMajorVersion = 1;
MailIEBandMinorVersion = 0;

LIBID_MailIEBand: TGUID = '{A078612A-EA84-4115-B2C7-7AE9EDA70C1F}';

IID_IGetMailBand: TGUID = '{B6D2A030-3025-42C7-8A3A-E697D1CE8E64}';
CLASS_GetMailBand: TGUID = '{C6872852-2478-4417-A4A0-BCB483B9B710}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IGetMailBand = interface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
GetMailBand = IGetMailBand;


// *********************************************************************//
// Interface: IGetMailBand
// Flags: (256) OleAutomation
// GUID: {B6D2A030-3025-42C7-8A3A-E697D1CE8E64}
// *********************************************************************//
IGetMailBand = interface(IUnknown)
['{B6D2A030-3025-42C7-8A3A-E697D1CE8E64}']
end;

// *********************************************************************//
// The Class CoGetMailBand provides a Create and CreateRemote method to
// create instances of the default interface IGetMailBand exposed by
// the CoClass GetMailBand. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoGetMailBand = class
class function Create: IGetMailBand;
class function CreateRemote(const MachineName: string): IGetMailBand;
//class function _Release:Interger;
end;

implementation

uses ComObj;

class function CoGetMailBand.Create: IGetMailBand;
begin
Result := CreateComObject(CLASS_GetMailBand) as IGetMailBand;
end;

class function CoGetMailBand.CreateRemote(const MachineName: string): IGetMailBand;
begin
Result := CreateRemoteComObject(MachineName, CLASS_GetMailBand) as IGetMailBand;
end;

end.

你还是拿http://www.euromind.com/iedelphi/ie5tools/bandobjects.htm 的例子去开吧.
你帖的这些代码我找不到类的什么.只有类对象的申明.

我在你贴的连接里没有找到_release() _addref()的例子，无从模仿

是在这个的TGetMailBand里面写_release()和_addref()么？
我写了后，每次点IE，IE就死。发现_addref被调用了两次_release也被调用了两次；就点IE的那一下。
===========================
unit BandUnit;

interface

uses
Windows, Sysutils, Messages, Registry, Shellapi, ActiveX, Classes, ComObj,
Shlobj, Dialogs, Commctrl, ShDocVW, IEForm, StdVcl;
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
{声明IDeskBand方法}
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;

{声明IObjectWithSite方法}
function SetSite(const pUnkSite: IUnknown): HResult
stdcall;
function GetSite(const riid: TIID
out site: IUnknown): HResult
stdcall;

{声明IPersistStream方法}
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}';
{以下是系统接口的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 = 250;
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
//如果pUnkSite不为NULL, 则表示要建立一个新的现场
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 := TForm1.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 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;
{IE用来指定浏览栏的标志符以及视图模式}
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;

{TIEClassFac类实现COM组件的注册}
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
{添加附加的注册表项}
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.

http://www.delphifans.com/SoftView/SoftView_127.html
俺的源码下载自这里

TDelphiBand = class(TComObject, IDeskBand, IPersist, IPersistStreamInit, IObjectWithSite, IContextMenu, IInputObject)
private
MenuItems : Integer;
HasFocus: Boolean;
BandID: DWORD;
SavedWndProc: twndmethod;
ParentWnd: HWND;
Site: IInputObjectSite;
cmdTarget: IOleCommandTarget;
BandForm: TBandform;
IE : IWebbrowser2;
public
// IDeskBand methods
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;
// IPersistStreamInit methods
function InitNew: HResult
stdcall;
function GetClassID(out classID: TCLSID): HResult
stdcall;
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;
// IObjectWithSite methods
function SetSite(const pUnkSite: IUnknown): HResult
stdcall;
function GetSite(const riid: TIID
out site: IUnknown): HResult
stdcall;
// IContextMenu methods
function QueryContextMenu(Menu: HMENU
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult
stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult
stdcall;
function GetCommandString(idCmd, uType: UINT
pwReserved: PUINT
pszName: LPSTR
cchMax: UINT): HResult
stdcall;
/// IInputObject methods
function UIActivateIO(fActivate: BOOL
var lpMsg: TMsg): HResult
stdcall;
function HasFocusIO: HResult
stdcall;
function TranslateAcceleratorIO(var lpMsg: TMsg): HResult
stdcall;

procedure FocusChange(bHasFocus: Boolean);
procedure UpdateBandInfo;
procedure BandWndProc(var Message: TMessage);
end;

这个地方你自己重载IUNknown的3个方法就可以了.你可以参考下TComObject的实现

_addref和_release好懂，QueryInterface就一窍不通了。看若干资料说是处理客户端什么的，似乎和我的IE工具条没有什么关系

看看COM的书,在你的这个运用中你直接调用父类的QueryInterface就可以了

主要是另外2个方法控制记数

添加如下代码后，IE就起不来了。

function TGetMailBand.QueryInterface(const IID: TGUID
out Obj): HResult
stdcall;
Begin
Result:=(self as TComObject).QueryInterface(IID,Obj);
end;
function TGetMailBand._AddRef:Integer;stdcall;
Begin
Result:=InterLockedIncrement(FRefCount);
End;
function TGetMailBand._Release: integer;stdcall;
var
ifReg:WideString;
n:Integer;
begin
ShowMessage(IntToStr(FRefCount));
Result:=InterLockedDecrement(FRefCount);
end;

希望能找到一个真正跑得动的代码来研究。看了若干资料，都不是讲这种IE的工具栏的情况，很迷惑

我把上面那三个函数实现到了TDelphiBand里，结果在IE里一点开工具栏ie自己就退出了。所有已经打开的窗口都退出了。

为什么这样写也不能编译？
function TGetMailBand._Release: integer;stdcall;
begin
Result:=inherited;
end;
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
为什么这样写也不能运行成功？（都是把带它的IE搞死报错）
function TDelphiBand._Release: integer;stdcall;
var
COTemp: IUnKnown;
n:Integer;
begin
COTemp:=self;
n:=COTemp._Release;
//ShowMessage(IntToStr);
Result:=n;
end;