On the ActiveX control Project menu, click References, and added VB
IObjectSafety Interface (c:\windows\system32\Objsafe.tlb) -> I did not
create this .tlb file myself, it's already there in c:\windows\system32.
In the ActiveX control project, I have a module called 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
In the ActiveX control project, in the control:
Option Explicit
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_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
Thank you.
"Igor Tandetnik" <it********@mvps.org> wrote in message
news:u4**************@TK2MSFTNGP09.phx.gbl...
"fniles" <fn****@pfmail.com> wrote in message
news:en**************@tk2msftngp13.phx.gbl I have an ActiveX control in my web page that I tried to access using
intranet.
I have implemented IObjectSafety in the ActiveX control, and when I
created the CAB file using VB Pakage and Deployment Wizard, under
"Safety Settings" I selected "Yes" for "Safe for Scripting" and "Yes"
for "Safe for Initialization". I also have signed the CAB file.
In IE, the option 'Script ActiveX controls marked Safe for Scripting'
is already set to 'Enable' (I use Security setting "Medium-Low").
I get a warning message 'An ActiveX control might be unsafe to
interact with other parts of the page. Do you want to allow this
interaction?'
Show how you implement IObjectSafety. It looks like you do it incorrectly.
--
With best wishes,
Igor Tandetnik
With sufficient thrust, pigs fly just fine. However, this is not
necessarily a good idea. It is hard to be sure where they are going to
land, and it could be dangerous sitting under them as they fly
overhead. -- RFC 1925
