| fniles 2005-11-25, 6:55 pm |
| 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" <itandetnik@mvps.org> wrote in message
news:u4vRDle8FHA.1420@TK2MSFTNGP09.phx.gbl...
> "fniles" <fniles@pfmail.com> wrote in message
> news:enNzPge8FHA.1140@tk2msftngp13.phx.gbl
>
> 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
>
|