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