VB中實現IObjectSafety接口以聲明控件安全的方法??

轉載自：http://www.cnblogs.com/Shana/archive/2009/06/24/VB_Iobjsafe.html

VB編寫的ActiveX控件，在被Javascript腳本調用時會彈出討厭的對話框，警告用戶即將運行不安全的ActiveX腳本，因此必須要實現IObjectSafety接口以聲明控件是腳本安全的，下面是具體方法：

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

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

????? 3. 打開記事本，粘貼下面的代碼然后另存為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. 運行cmd進入命令行，利用CD命令進入工程目錄，然后輸入以下命令并回車：

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

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

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

????? 7. 給你的工程添加一個模塊，模塊的代碼如下，模塊名稱為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. 修改工程屬性，將啟動項改為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. 在"文件"菜單中點擊"生成ocx文件"，ok，現在你的控件已經是腳本安全的了，可以直接使用js腳本進行調用了。

總結

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

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。