实现vb activeX控件安全性（IE不提示安全问题） 继承IObjectSafe
发布时间：2020-12-16 23:02:01 所属栏目：大数据 来源：网络整理
导读：原文http://support.microsoft.com/kb/182598/zh-cn 从 Visual Basic 6.0 CD-ROM（安装目录） 中获取 OLE 自动化类型库生成器。若要执行此操作将所有四个文件从 /Common/Tools/VB/Unsupprt/Typlib/ 文件夹复制到您的项目文件夹中。 将以下文本复制到记事本，
|
原文http://support.microsoft.com/kb/182598/zh-cn 从 Visual Basic 6.0 CD-ROM（安装目录） 中获取 OLE 自动化类型库生成器。若要执行此操作将所有四个文件从 /Common/Tools/VB/Unsupprt/Typlib/ 文件夹复制到您的项目文件夹中。 将以下文本复制到记事本，，将文件保存为 Objsafe.odl 项目文件夹中： [
MKTYPLIB objsafe.odl /tlb objsafe.tlb
利用tlb注册工具将文件注册
注册工具可以在http://download.csdn.net/source/2841891下载到
从 Visual Basic 创建 ActiveX 控件项目
在
项目 菜单上单击
引用 ，浏览到并添加 Objsafe.tlb，您早先创建的。
添加一个新的模块到您的项目与下面的代码并命名模块 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两件变量的值分别指定了脚本安全和初始化安全取值。
打开您的控件的代码窗口。将下面的代码行添加到声明部分中
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,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_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
生成.ocx控件，用web页面引用。控件与页面交互时IE不再提示安全问题。
（编辑：李大同） 【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容! |