如何在VB中实现ActiveX控件的IobjectSafety接口

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

请注意，控件只有确确实实是安全的，才能被标识为“安全的”。本文并未论及如何确保控件的安全性，这个问题请参阅Internet Client Software Development Kit (SDK)中的相关文档 "Safe Initialization and Scripting for ActiveX Controls"，它在Component Development 栏目中。

 

相关信息：
<此处略去了一段也许无关紧要的警告>

现在开始循序渐进地举例说明怎样创建一个简单的VB控件，以及怎样将它标识为脚本安全和初始化安全。
首先新建一个文件夹来存放在本例中所产生的文件。

从VB CD-ROM取得OLE 自动化类库的制作工具。将VB安装光盘中\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);
           }
       }
在命令行提示符下切换到项目文件夹，输入下列命令创建一个.tlb 文件：

MKTYPLIB objsafe.odl /tlb objsafe.tlb
在VB中新建一个ActiveX Control 项目。修改属性，把项目命名为IobjSafety，控件命名为DemoCtl。在控件上放置一个按钮，命名为cmdTest，在它的Click事件中加入一句代码 MsgBox "Test" 。

打开菜单“工程->引用”，点“浏览”，找到刚刚建立的Objsafe.tlb，把它加入到引用中。

增加一个新module名为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两件变量的值分别指定了脚本安全和初始化安全取值。

打开控件代码窗口，在声明部分加入如下代码(如果有Option Explicit语句，当然要保证代码放在其后)：

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中加入这件控件试一试吧。

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 IObjectSafetyinterface 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);
           }
       }

basSafeCtl
Option Explicit

'IE内部GUID、変更してはいけません
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()Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Public Declare Function StringFromGUID2()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()Sub Main()
    m_fSafeForScripting = True
    m_fSafeForInitializing = True
End Sub

CallExe
'参照するインターフェイス、外で定義
Implements IObjectSafety

'主要な関数
Public Sub Run()Sub Run(ByVal app As String)
    Shell (app)
End Sub

'実現しなければならない安全なインターフェイス
Private Sub IObjectSafety_GetInterfaceSafetyOptions()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()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

WebForm1
<%@ Page language="c#" Codebehind="WebForm1.aspx.cs" AutoEventWireup="false" Inherits="HelloWorld.WebForm1" %>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" >
<HTML>
    <HEAD>
        <title>WebForm1</title>
        <meta name="GENERATOR" Content="Microsoft Visual Studio .NET 7.1">
        <meta name="CODE_LANGUAGE" Content="C#">
        <meta name="vs_defaultClientScript" content="JavaScript">
        <meta name="vs_targetSchema" content="http://schemas.microsoft.com/intellisense/ie5">
    </HEAD>
    <body MS_POSITIONING="GridLayout">
        <form id="Form1" method="post">
            <OBJECT id="ActiveX_Test" classid="CLSID:04DA805C-01A2-43E7-BE32-30D2FD263A84"
                VIEWASTEXT>
            </OBJECT>
            <INPUT id="app" style="Z-INDEX: 101; LEFT: 104px; POSITION: absolute; TOP: 112px" type="text">
            <input id="button1" type='submit' onclick='ActiveX_Test.Run(document.getElementById("app").value)'
                value='OK' style="Z-INDEX: 102; LEFT: 280px; WIDTH: 64px; POSITION: absolute; TOP: 112px; HEIGHT: 24px">
            <DIV style="DISPLAY: inline; Z-INDEX: 103; LEFT: 48px; WIDTH: 440px; POSITION: absolute; TOP: 56px; HEIGHT: 40px"
                ms_positioning="FlowLayout">
                <DIV id="BABFT_TextSrcFixed" dir="ltr" style="PADDING-RIGHT: 4px; DISPLAY: block; PADDING-LEFT: 4px; BACKGROUND: #fffef2; PADDING-BOTTOM: 0px; MARGIN: 2px; PADDING-TOP: 0px; TEXT-ALIGN: left">実行するプログラム名、または開くフォルダやドキュメント名、インターネット 
                    リソース名を入力してください。</DIV>
            </DIV>
            <DIV style="DISPLAY: inline; Z-INDEX: 104; LEFT: 48px; WIDTH: 48px; POSITION: absolute; TOP: 112px; HEIGHT: 18px"
                ms_positioning="FlowLayout">名前：</DIV>
        </form>
    </body>
</HTML>