总述 本文叙述了如何在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,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