'//////////////////////////////////////////////////////////////////////////////
'//
'// IObjectSafety Interface Implementation
'//
 
'------------------------------------------------------------------------------
' IObjectSafety_GetInterfaceSafetyOptions
'------------------------------------------------------------------------------
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
 
'------------------------------------------------------------------------------
' IObjectSafety_SetInterfaceSafetyOptions
'------------------------------------------------------------------------------
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

[url]http://www.ptahsoft.ch/test/OBJSAFE.zip[/url]