实现vb activeX控件安全性(IE不提示安全问题) 继承IObjectSafety接口

原文http://support.microsoft.com/kb/182598/zh-cn

从 Visual Basic 6.0 CD-ROM(安装目录) 中获取 OLE 自动化类型库生成器。若要执行此操作将所有四个文件从 /Common/Tools/VB/Unsupprt/Typlib/ 文件夹复制到您的项目文件夹中。

将以下文本复制到记事本,,将文件保存为 Objsafe.odl 项目文件夹中:

[


uuid(C67830E0-D11D-11cf-BD80-00AA00575603),


helpstring("VB IObjectSafety Interface"),


version(1.0)


]


library IObjectSafetyTLB


{


importlib("stdole2.tlb");


[


uuid(CB5BDC81-93C1-11cf-8F20-00805F2CD064),


helpstring("IObjectSafety Interface"),


odl


]


interface IObjectSafety:IUnknown {


[helpstring("GetInterfaceSafetyOptions")]


HRESULT GetInterfaceSafetyOptions(


[in] long riid,


[in] long *pdwSupportedOptions,


[in] long *pdwEnabledOptions);





[helpstring("SetInterfaceSafetyOptions")]


HRESULT SetInterfaceSafetyOptions(


[in] long riid,


[in] long dwOptionsSetMask,


[in] long dwEnabledOptions);


}


}











在命令提示符使用 CD

将移动到项目文件夹,然后键入以下命令来生成.tlb 文件的命令:
MKTYPLIB objsafe.odl /tlb objsafe.tlb

利用tlb注册工具将文件注册 

注册工具可以在http://download.csdn.net/source/2841891下载到

从 Visual Basic 创建 ActiveX 控件项目

项目 菜单上单击 引用 ,浏览到并添加 Objsafe.tlb,您早先创建的。

添加一个新的模块到您的项目与下面的代码并命名模块 basSafeCtl

Option Explicit





Public Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"


Public Const IID_IPersistStorage = _


"{0000010A-0000-0000-C000-000000000046}"


Public Const IID_IPersistStream = _


"{00000109-0000-0000-C000-000000000046}"


Public Const IID_IPersistPropertyBag = _


"{37D84F60-42CB-11CE-8135-00AA004BB851}"





Public Const INTERFACESAFE_FOR_UNTRUSTED_CALLER = &H1


Public Const INTERFACESAFE_FOR_UNTRUSTED_DATA = &H2


Public Const E_NOINTERFACE = &H80004002


Public Const E_FAIL = &H80004005


Public Const MAX_GUIDLEN = 40





Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _


(pDest As Any, pSource As Any, ByVal ByteLen As Long)


Public Declare Function StringFromGUID2 Lib "ole32.dll" (rguid As _


Any, ByVal lpstrClsId As Long, ByVal cbMax As Integer) As Long





Public Type udtGUID


Data1 As Long


Data2 As Integer


Data3 As Integer


Data4(7) As Byte


End Type





Public m_fSafeForScripting As Boolean


Public m_fSafeForInitializing As Boolean





Sub Main()


m_fSafeForScripting = True


m_fSafeForInitializing = True


End Sub

在工程属性中把启动对象改成Sub Main确保上述代码会被执行。m_fSafeForScripting 和m_fSafeForInitializing两件变量的值分别指定了脚本安全和初始化安全取值。



打开您的控件的代码窗口。将下面的代码行添加到声明部分中





Implements IObjectSafety





将下面的两个过程复制到您的控件的代码





Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As _


Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long)





Dim Rc As Long


Dim rClsId As udtGUID


Dim IID As String


Dim bIID() As Byte





pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _


INTERFACESAFE_FOR_UNTRUSTED_DATA





If (riid <> 0) Then


CopyMemory rClsId, ByVal riid, Len(rClsId)





bIID = String$(MAX_GUIDLEN, 0)


Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)


Rc = InStr(1, bIID, vbNullChar) - 1


IID = Left$(UCase(bIID), Rc)





Select Case IID


Case IID_IDispatch


pdwEnabledOptions = IIf(m_fSafeForScripting, _


INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0)


Exit Sub


Case IID_IPersistStorage, IID_IPersistStream, _


IID_IPersistPropertyBag


pdwEnabledOptions = IIf(m_fSafeForInitializing, _


INTERFACESAFE_FOR_UNTRUSTED_DATA, 0)


Exit Sub


Case Else


Err.Raise E_NOINTERFACE


Exit Sub


End Select


End If


End Sub





Private Sub IObjectSafety_SetInterfaceSafetyOptions(ByVal riid As _


Long, ByVal dwOptionsSetMask As Long, ByVal dwEnabledOptions As Long)


Dim Rc As Long


Dim rClsId As udtGUID


Dim IID As String


Dim bIID() As Byte





If (riid <> 0) Then


CopyMemory rClsId, ByVal riid, Len(rClsId)





bIID = String$(MAX_GUIDLEN, 0)


Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)


Rc = InStr(1, bIID, vbNullChar) - 1


IID = Left$(UCase(bIID), Rc)





Select Case IID


Case IID_IDispatch


If ((dwEnabledOptions And dwOptionsSetMask) <> _


INTERFACESAFE_FOR_UNTRUSTED_CALLER) Then


Err.Raise E_FAIL


Exit Sub


Else


If Not m_fSafeForScripting Then


Err.Raise E_FAIL


End If


Exit Sub


End If





Case IID_IPersistStorage, IID_IPersistStream, _


IID_IPersistPropertyBag


If ((dwEnabledOptions And dwOptionsSetMask) <> _


INTERFACESAFE_FOR_UNTRUSTED_DATA) Then


Err.Raise E_FAIL


Exit Sub


Else


If Not m_fSafeForInitializing Then


Err.Raise E_FAIL


End If


Exit Sub


End If





Case Else


Err.Raise E_NOINTERFACE


Exit Sub


End Select


End If


End Sub




生成.ocx控件,用web页面引用。控件与页面交互时IE不再提示安全问题。










你可能感兴趣的:(学习笔记)