Implement the IObjectSafety interface in VB to declare the control security method

Source: Internet
Author: User

 

ActiveX Control compiled by VB will pop up a nasty dialog box when it is called by Javascript scripts, warning users to be running insecure ActiveX scripts, therefore, you must implement the IObjectSafety interface to declare that the control is script-safe. The following describes the specific method:

1. Create a directory as your project directory;

2. insert the installation disk of VB and enter % \ COMMON \ TOOLS \ VB \ UNSUPPRT \ TYPLIB in the % installation root directory. Then, copy the four files C1.EXE and CL. EXE, MKTYPLIB. EXE and MSPDB41.DLL are copied to the project directory;

3. Open notepad, paste the following code, save it as objsafe. odl, and save it in the project directory;

[
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. Run cmd to enter the command line, use the CD command to enter the project directory, then enter the following command and press Enter:

MKTYPLIB objsafe. odl/tlb objsafe. tlb

5. Go to Visual Basic to create an ActiveX space project. In the properties menu, change the project name to IObjSafety and the control name to DemoCtl. Add a button to the space and add MsgBox "Test" to the button clicking event ";

6. Click "Reference" in the "project" menu, Click Browse, and select Add Objsafe. tlb;

7. Add a module to your project. The module code is as follows. The module name is 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 _
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

8. Modify the project properties and change the startup Item to Sub_Main;

9. In your own control, add a line after Option Explicit: Implements IObjectSafety;

10. Add the following code to your control:

Private Sub IObjectSafety_GetInterfaceSafetyOptions (ByVal riid _
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 _
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_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

11. Click "generate ocx file" in the "file" menu. OK. Now your control is script safe and can be called directly using JS scripts.

 

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.