[求助]加载宏时如何关闭不安全控件初始化对话框

star_sur

加载宏时如何关闭不安全控件初始化对话框？

网上看到网友翻译的ｍｓｄｎ资料，好像只是针对网页控件的，里面有句话“可将其功能显露给 Internet Explorer 的“设置脚本安全性”和“设置初始化安全性”安全” ，我试验的acad2002下vba的dvb里面好像无效，有人遇到过吗？

（本文叙述了如何在VB中实现控件的IobjectSafety接口，
以标志该控件是脚本安全和初始化安全的。
VB控件默认的处理方式是在注册表中注册组件类来标识其安全性，
但实现IobjectSafety接口是更好的方法。
本文包括了实现过程中所需的所有代码。

1、将以下文本复制到记事本, 并作为 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);
                      }
                  }
---------------------------------------------------------------------
2、在命令提示符处, 使用 CD < 路径 > 命令移到项目文件夹, 然后键入以下命令以生成 .tlb 文件：
MKTYPLIB objsafe.odl /tlb objsafe.tlb
---------------------------------------------------------------------
3、在VB中新建一个ActiveX Control 项目。修改属性，把项目命名为IobjSafety，控件命名为DemoCtl。在控件上放置一个按钮，命名为cmdTest，在它的Click事件中加入一句代码 MsgBox "Test"
---------------------------------------------------------------------
4、在 项目 菜单上, 单击 引用 ， 浏览并添加 Objsafe.tlb
---------------------------------------------------------------------
5、项目添加一个新模块并命名模块 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
---------------------------------------------------------------------
6、在工程属性中把启动对象改成Sub Main确保上述代码会被执行。m_fSafeForScripting 和m_fSafeForInitializing两件变量的值分别指定了脚本安全和初始化安全取值。
8、打开控件的代码窗口。 将下列行的代码添加到声明部分 （OptionExplicit 后）：
                     Implements IObjectSafety
---------------------------------------------------------------------
9、将下面两个过程复制到控件代码：
                 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
---------------------------------------------------------------------
10、在 文件 菜单上, 保存您的项目和文件。 生成 OCX 文件从项目。 现在您控件实现 IObjectSafety 接口。 要测试, 在一个 .htm 文件中插入控件。

相关连接：
http://topic.csdn.net/t/20050104/23/3699426.html               原理
             IObjectSafety              是一个接口，它可将其功能显露给              Internet              Explorer              的“设置脚本安全性”和“设置初始化安全性”安全特性。对具有支持未受托客户（或那些不能预料其特定功能的，或不能确保安全使用的客户）接口的对象，例如脚本，应当实现              IObjectSafety              接口。该接口允许您指定对象的哪一部分需要保护而不被使用。  
---------------------------------------------------------------------
             使用              IObjectSafety              可以将对象及其组成部分标记为以下三类：
             1、对未受托的              Automation              客户和脚本设置              Automation              安全性
             2、对未受托数据设置初始化安全性
             3、对未受托脚本设置运行安全性
---------------------------------------------------------------------
可以为您的对象考虑三种方案：
             1、 对象的所有属性和方法总是设置脚本安全性的。在该方案中，您可以通过不在IObjectSafety_SetInterfaceSafetyOptions              接口方法中返回错误来通知客户您的对象设置了脚本安全性。这样就能成功地创建和运行您的对象了。
             2、对象永不设置脚本安全性。在这种情况下，您可以通过在              IObjectSafety_SetInterfaceSafetyOptions              接口方法中返回一个错误，E_Fail              来通知客户您的对象不安全。这样就防止了客户通过脚本来访问任何方法或属性了
             3、对象上的部分属性和方法，但不是全部，未设置脚本安全性。在这种情况下，您可以通知客户整个对象都不安全，也可以通知客户您的对象是安全的，但禁用不安全的属性和方法。
--------------------------------------------------------------------
TLB用于定义接口.   
             Implements                在VB中继承并实现定义的              接口.   
             IObjectSafety_GetInterfaceSafetyOptions   
             IObjectSafety_SetInterfaceSafetyOptions   
             是定义IObjectSafety的一个InterfaceSafetyOptions属性.要做的动作.
--------------------------------------------------------------------
[   
                                 uuid(C67830E0-D11D-11cf-BD80-00AA00575603),     
                                 helpstring("VB              IObjectSafety              Interface"),   
                                 version(1.0)   
                         ]   
    
             这是接口定义语言(IDL：Interface              Definition              Language)，C67830E0-D11D-11cf-BD80-00AA00575603不可以任意写，它代表了IObjectSafety这个接口，改了别人就找不到它了，如果创建一个新的类或接口，则可以任意写，就是一组16进制数，但一般都用GUIDGEN.EXE生成，可以保证不重复
===============================================================================

star_sur

斑竹老大帮忙研究一下好吗？