| 
 总述本文叙述了如何在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 = &H1Public 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 udtGUIDData1 As Long
 Data2 As Integer
 Data3 As Integer
 Data4(7) As Byte
 End Type
       Public m_fSafeForScripting As BooleanPublic 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 LongDim rClsId  As udtGUID
 Dim IID     As String
 Dim bIID()  As Byte
           pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _INTERFACESAFE_FOR_UNTRUSTED_DATA
           If (riid <> 0) ThenCopyMemory 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 IIDCase 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) ThenCopyMemory 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 IIDCase 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 ElseErr.Raise E_NOINTERFACE
 Exit Sub
 End Select
 End If
 End Sub
 保存后,把工程编译成OCX文件。现在控件已经实现了IObjectSafety 接口。在.htm中加入这件控件试一试吧。
 
 
 |