如何在 Visual Basic 控件中实现 IObjectSafety

来源：互联网发布：淘宝公益宝贝计划编辑：程序博客网时间：2024/06/05 10:35

下面的步骤说明如何创建一个简单的 Visual Basic 控件并将其标记为可安全执行脚本和 $ 初始化。

创建一个新的文件夹，您可以在其中保存创建此示例中的所有文件。
从 Visual Basic 6.0 CD-ROM 中获取 OLE 自动化类型库生成器。若要执行此操作将所有四个文件从 \Common\Tools\VB\Unsupprt\Typlib\ 文件夹复制到您的项目文件夹中。注意：从 \VB5.0\Tools\Unsupprt\Typlib\ 可视 Basic 5.0 中的文件夹中复制所有文件。

将以下文本复制到记事本，，将文件保存为 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
从 Visual Basic 创建 ActiveX 控件项目。在属性列表中项目的名称改为 IObjSafety 和DemoCtl 到控件的名称。将名为 cmdTest 在控件上的命令按钮。在该 cmdTest 的 Click 事件处理中将 MsgBox"测试"语句放。
在项目菜单上单击引用，浏览到并添加 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 来执行该 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 文件。您的控件现在实现 IObjectSafety 接口。若要其测试插入一个.htm 文件中的控件。