VB中實(shí)現(xiàn)IObjectSafety接口以聲明控件安全的方法??

轉(zhuǎn)載自：http://www.cnblogs.com/Shana/archive/2009/06/24/VB_Iobjsafe.html

VB編寫的ActiveX控件，在被Javascript腳本調(diào)用時(shí)會(huì)彈出討厭的對(duì)話框，警告用戶即將運(yùn)行不安全的ActiveX腳本，因此必須要實(shí)現(xiàn)IObjectSafety接口以聲明控件是腳本安全的，下面是具體方法：

????? 1. 新建一個(gè)目錄作為你的工程目錄；

????? 2. 插入VB的安裝盤，進(jìn)入%安裝盤根目錄%\COMMON\TOOLS\VB\UNSUPPRT\TYPLIB，將里面的4個(gè)文件C1.EXE、CL.EXE、MKTYPLIB.EXE、MSPDB41.DLL拷貝到剛才的工程目錄中；

????? 3. 打開(kāi)記事本，粘貼下面的代碼然后另存為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);
?????????? }
?????? }

????? 4. 運(yùn)行cmd進(jìn)入命令行，利用CD命令進(jìn)入工程目錄，然后輸入以下命令并回車：

??????????? MKTYPLIB objsafe.odl /tlb objsafe.tlb

????? 5. 進(jìn)入Visual Basic，新建ActiveX空間工程。在屬性菜單里，將工程名修改為IObjSafety，控件名修改為DemoCtl。給空間中添加一個(gè)按鈕，并在這個(gè)按鈕的點(diǎn)擊事件里加入一句：MsgBox "Test"；

????? 6. 在"工程"菜單里點(diǎn)擊"引用"，接著點(diǎn)瀏覽，然后選擇加入Objsafe.tlb；

????? 7. 給你的工程添加一個(gè)模塊，模塊的代碼如下，模塊名稱為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

????? 8. 修改工程屬性，將啟動(dòng)項(xiàng)改為Sub_Main；

????? 9. 在你自己的控件中，在Option Explicit后加入一行：Implements IObjectSafety；

????? 10. 給你的控件中加入下面的代碼：

?????? 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

????? 11. 在"文件"菜單中點(diǎn)擊"生成ocx文件"，ok，現(xiàn)在你的控件已經(jīng)是腳本安全的了，可以直接使用js腳本進(jìn)行調(diào)用了。

總結(jié)

以上是生活随笔為你收集整理的VB中实现IObjectSafety接口以声明控件安全的方法的全部?jī)?nèi)容，希望文章能夠幫你解決所遇到的問(wèn)題。

如果覺(jué)得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。