*继承IObjectSafety接口，实现vb activeX控件安全性（IE不提示安全问题）

原文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 <path>

 将移动到项目文件夹，然后键入以下命令来生成.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不再提示安全问题。