自己写的activex控件总是提示"在此页上的activex控件和本页上其他部分的交互可能不安全,你想允许这种交互吗?" . 比较烦人,而且提示完之后ie就死了.
在网上搜了好久终于找到了解决办法,就是网上说的比较多的那种方法,实现IObjectSafety接口
其实网上的那种方式是可用的,在此再记录一下,也希望对没有解决此问题的朋友有帮助.
1.创建一个文件夹,复制下述代码
[
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);
}
}
将上面这段代码复制下来,在新建的文件夹中用记事本建立一个文件,将代码粘贴进去,然后将文件名改为objsafe.odl(一定要是odl格式的).
2.在vb的安装盘上,有个COMMON\TOOLS\VB\UNSUPPRT\TYPLIB所有的文件拷贝到新建的文件夹中. 双击运行其中的MKTYPLIB.EXE(最好不要在命令行下运行,命令行下运行的可能会报错) , 会提示选择odl文件,选择刚才建立的那个objsafe.odl文件,然后就可以创建出objsafe.tlb文件(备用)
3.下面开始做activex控件.
打开vb6,新建一个activex 控件(英文版的activex control)工程 ,
默认会有一个类似窗体的UserControl1控件.
建议最好改一下名,如将工程名改为TestPro,将控件名改为TestControl.
菜单: 工程---引用 点击浏览,找到刚才创建的objsafe.tlb 确定.
在工程上 右键 添加模块 , 创建一个名为basSafeCtl.bas的模块,并将下面的代码复制到模块中.
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
双击控件(TestControl),
在代码区的声明部分添加:
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, 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_IPersistPropertyBags
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
4. 然后,在 菜单: 工程 --- Test属性(即本工程的属性) 里 ,通用tab页中,将启动对象选择为Sub Main , 确保自己添加的模块能被运行到.
然后可以自己在控件中加一个按钮 ,并在按钮事件中弹出一条信息 MsgBox("test")
5. 生成ocx(文件---生成Test.ocx) 并注册(regsvr32 路径\Test.ocx)
6. 写一个html页面进行测试
就不会出现烦人的 提示框了.
附上 vb 安装目录下的 typlib文件夹的内容.
分享到:
相关推荐
用VB制作ActiveX控件
用VB做ActiveX控件 ActiveX控件的入门首选!
这是使用VB 设计的注册ActiveX控件软件, 包含VB 调用系统命令的使用, 并使用了VB获取系统路径, 调用API函数, 复制文件等高级功能。 本资源还包含了一些VB常用的ActiveX控件, 如Flash8.ocx, comctl32.ocx, mci32.ocx,...
精彩编程与编程技巧-利用vb6开发ActiveX控件 ...
这是最新修改版,有我用它创作控件的源码。希望对大家有所裨益。
VB教程中的ActiveX控件
vb6.0 Activex控件制作实例 vb6.0本身就带了打包工具“Package & Deployment 向导”,根据打包向导一步步做就可以,但是要注意的是“安全性设置”中要全选“是”,否则无法在网页中显示控件。
VB控制Excel中插入的ActiveX控件,简单易懂,利于新手。
内含(源码):VB_ActiveX控件、界面元素类 、系统类等等。
VB之精彩编程-VB6.0动态加载ActiveX控件漫谈
54 款很不错的VB ActiveX控件
VB Squared ActiveX Skin控件主要特色: 内置6个皮肤Built in Skins 用皮肤创建程序创建属于自己的皮肤 兼容Aligned Controls 兼容Visual Basic Menus 在运行时可以Activate和De-Activate 兼容所有WindowBorder ...
本书适合于学习VB ActiveX编程、利用ActiveX控件开发Internet/Intranet应用的人员以及希望进一步提高编程水平、开掘 Visual Basic能力 的软件开发人员,是一本难得的好书! 很不错的书,是学习VB ActiveX编程的难得...
VB6.0动态加载ActiveX控件漫谈 深圳 罗汉军 罗德昌 熟悉VB的朋友对使用ActiveX控件一定不会陌生,众多控件极大地方便了编程, 但唯一的缺陷是不能动态加载控件,必须在设计时通过引用,将控件放置在窗体上。 VB6.0...
VB Animation GIF ActiveX控件 YQSoft公司开发的一款功能强大的OCX控件,让你在Visual Basic程序中实现GIF动画,程序很小但功能强大而且是纯VB代码开发,没有使用任何其他的控件,控件仅40K,安装包只有12K,...
这是使用VB 的MMcontrol控件播放声音、Animate控件显示AVI动画的音乐播放器软件, 包含ActiveX控件的基本和高级应用。 软件还使用数组存储播放列表, 支持使用MMcontrol控件切换上/下一首音乐。