vb写的activex控件不再弹出警告提示

jackeysion

浏览: 129554 次
性别:
来自: 济南

最近访客更多访客>>

yiyu

dotfeng

xx5333

yuxiatongzhi

博主相关

博客

微博

相册

留言

关于我

文章分类

社区版块

存档分类

VB IE C C++C#

自己写的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文件夹的内容.

TYPLIB.rar (352 KB)
下载次数: 136

分享到：