如何在 Visual Basic 控件中实现 IObjectSafety

1. 创建一个新的文件夹，您可以在其中保存创建此示例中的所有文件。
2. 从 Visual Basic 6.0 CD-ROM 中获取 OLE 自动化类型库生成器。若要执行此操作将所有四个文件从 CommonToolsVBUnsupprtTyplib 文件夹复制到您的项目文件夹中。注意： 从 VB5.0ToolsUnsupprtTyplib 可视 Basic 5.0 中的文件夹中复制所有文件。
3. 将以下文本复制到记事本，，将文件保存为 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);
              }
          }
   					

4. 在命令提示符使用 CD <path> 将移动到项目文件夹，然后键入以下命令来生成.tlb 文件的命令：
   MKTYPLIB objsafe.odl /tlb objsafe.tlb
5. 从 Visual Basic 创建 ActiveX 控件项目。在 属性 列表中项目的名称改为 IObjSafety 和 DemoCtl 到控件的名称。将名为 cmdTest 在控件上的命令按钮。在该 cmdTest 的 Click 事件处理中将 MsgBox"测试"语句放。
6. 在 项目 菜单上单击 引用，浏览到并添加 Objsafe.tlb，您早先创建的。
7. 将一个新的模块添加到您的项目与下面的代码并命名模块 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
   					

8. 从项目属性更改为 Sub Main 来执行该 Sub Main 上面的启动对象。使用 m_fSafeForScripting 和 m_fSafeForInitializing 变量指定的安全编写脚本和/或初始化变量的值。
9. 打开您的控件的代码窗口。将下面的代码行添加到声明部分中，（右后选项显式或作为第一个）：

   Implements IObjectSafety
   					

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

          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,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_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
    					

11. 在 文件 菜单上将保存您的项目和文件。请从您的项目的 OCX 文件。您的控件现在实现 IObjectSafety 接口。若要其测试插入一个.htm 文件中的控件。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!