VB中实现IObjectSafety接口以声明控件安全的方法
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
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
原文地址：https://www.jb51.cc/vb/259114.html
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
