總述
本文敘述了如何在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
