Option Explicit
Implements IObjectSafety

' IObjectSafety_GetInterfaceSafetyOptions --------------------
Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long)
    Dim Rc          As Long
    Dim rClsId      As uGUID
    Dim IID         As String
    Dim bIID()      As Byte

    pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or INTERFACESAFE_FOR_UNTRUSTED_DATA 

' Ustaw i zwroc obslugiwane przez obiekt opcje bezpieczenstwa. 

    If (riid <> 0) Then 
    ' Sprawdz wskaznik do identyfikatora interfejsu.

        CopyMemory rClsId, ByVal riid, Len(rClsId)
        ' Zapisz guid interfejsu do struktury. 
    
        bIID = String$(MAX_GUIDLEN, 0) 
        ' Utworz tablice bajtow 

        Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN) 
        ' Pobierz clsid ze struktury guid. 

        Rc = InStr(1, bIID, vbNullChar) - 1 
        ' Sprawdz, czy na koncu tekstu nie ma pustych znakow. 

        IID = Left$(UCase(bIID), Rc) 
        ' Obetnij puste znaki i zamien na wielkie litery do porownania.

        Select Case IID 
        Case IID_IDispatch ' Zadane opcje bezpieczenstwa 
            pdwEnabledOptions = IIf(m_fSafeForScripting, INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0) 
            Exit Sub 
        Case IID_IPersistStorage, IID_IPersistStream, ID IPersistPropertyBag 
            pdwEnabledOptions = IIf(m_fSafeForInitializing, INTERFACESAFE_FOR_UNTRUSTED_DATA, 0) 
            Exit Sub 
        Case Else 
            Err.Raise E_NOINTERFACE ' BLAD - opcja nie obslugiwana 
            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 rClsZd      As uGUID 
    Dim IID         As String
    Dim bIID()      As Byte
 
    If (riid <> 0) Then 
    ' Sprawdz wskaznik do identyfikatora interfejsu.

        CopyMemory rClsId, ByVal riid, Len(rClsId) 
        ' Zapisz guid interfejsu do struktury. 
        
        bIID = String$(MAX_GUIDLEN, 0) 
        ' Utworz tablice bajtow. 

        Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN) 
        ' Pobierz clsid ze struktury guid. 

        Rc = ZnStr(1, bIID, vbNullChar) - 1 
        ' Sprawdz, czy na koncu tekstu nie ma pustych znakow. 

        IID = Left$(UCase(bIID), Rc)     
        ' Obetnij puste znaki i zamien na wielkie litery do porownania.
        
        Select Case IID 
        Case IID_IDispatch
            If ((dwEnabledOptions And dwOptionsSetMask) <> INTERFACESAFE FOR UNTRUSTED CALLER) Then 
                Err.Raise E_FAIL ' blad: nie obslugiwane. 
                Exit Sub
            End If 

            If Not m_fSafeForScripting Then Err.Raise E_FAIL 
            ' Czy ten obiekt jest bezpieczny ze wzgledu na skrypty?
            Exit Sub 
        Case IID_IPersistStorage, IID_IPersistStream, IID_IPersistPropertyBag 
            If ((dwEnabledOptions And dwOptionsSetMask) <> INTERFACESAFE_FOR_UNTRUSTED_DATA) Then 
                Err.Raise E_FAIL ' blad: nie obslugiwane. 
                Exit Sub 
            End If 
            If Not m_fSafeForInitializing Then Err.Raise E_FAIL 
            ' Czy ten obiekt jest bezpieczny ze wzgledu na inicjalizacje? 
            Exit Sub 
        Case Else 
            ' Zadany interfejs jest nieznany. 
            Err.Raise E_NOINTERFACE ' blad: nie obslugiwane. 
            Exit Sub 
        End Select
    End If 
End Sub 
'---------------------------------------------

' FunctionSafeToScript -----------------------
Public Function FunctionSafeToScript() As Boolean 
    FunctionSafeToScript = True 
End Function 
'---------------------------------------------

' FunctionNOTSafeToScript --------------------
Public Function FunctionNOTSafeToScript() As Boolean 
    FunctionNOTSafeToScript = True 
End Function 
'---------------------------------------------
