实现vb activeX控件安全性(IE不提示安全问题) 继承IObjectSafety接口

前端之家收集整理的这篇文章主要介绍了实现vb activeX控件安全性(IE不提示安全问题) 继承IObjectSafety接口前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

原文http://support.microsoft.com/kb/182598/zh-cn

从 Visual Basic 6.0 CD-ROM(安装目录) 中获取 OLE 自动化类型库生成器。若要执行此操作将所有四个文件从 /Common/Tools/VB/Unsupprt/Typlib/ 文件夹复制到您的项目文件夹中。

将以下文本复制到记事本,,将文件保存为 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);


}


}











在命令提示符使用 CD <path>

将移动到项目文件夹,然后键入以下命令来生成.tlb 文件的命令:
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不再提示安全问题。



原文链接:https://www.f2er.com/vb/261587.html

猜你在找的VB相关文章