VB中实现IObjectSafety接口以声明控件安全的方法

VB编写的ActiveX控件，在被Javascript脚本调用时会弹出讨厌的对话框，警告用户即将运行不安全的ActiveX脚本，因此必须要实现IObjectSafety接口以声明控件是脚本安全的，下面是具体方法：

1. 新建一个目录作为你的工程目录；

2. 插入VB的安装盘，进入%安装盘根目录%COMMONTOOLSVBUNSUPPRTTYPLIB，将里面的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

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

11. 在"文件"菜单中点击"生成ocx文件"，ok，现在你的控件已经是脚本安全的了，可以直接使用js脚本进行调用了。