Option Explicit '------------------------------------------------------------------- '컨트롤 인증 관련 '------------------------------------------------------------------- Implements IObjectSafety Private m_Safety As Boolean Private m_fMakeSafeForScripting As Boolean Public Sub CellPutText(ByVal row As Long, ByVal col As Long, _ ByVal text As String, Optional ByVal fColor As Long = vbBlack, _ Optional ByVal bColor As Long = vbWhite) SS1.row = row SS1.col = col SS1.text = text SS1.ForeColor = fColor SS1.BackColor = bColor End Sub Public Function CellGetText(ByVal row As Long, ByVal col As Long) As String SS1.row = row SS1.col = col CellGetText = SS1.text End Function Public Property Get MaxRows() As Long MaxRows = SS1.MaxRows End Property Public Property Let MaxRows(ByVal rows As Long) SS1.MaxRows = rows End Property Public Property Get MaxCols() As Long MaxCols = SS1.MaxCols End Property Public Property Let MaxCols(ByVal cols As Long) SS1.MaxCols = cols End Property '------------------------------------------------------------------- '시스템 이벤트 '------------------------------------------------------------------- Private Sub UserControl_Initialize() Safe = True End Sub '------------------------------------------------------------------- '컨트롤 인증 관련 '------------------------------------------------------------------- Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long) Dim Rc As Long ' function return code Dim rClsId As uGUID ' guid struct Dim IID As String ' interface id Dim bIID() As Byte ' byte array for interface id 'WriteLog "GetInterfaceSafetyOptions:: " & vbCrLf & " riid= " & CStr(riid) & vbCrLf pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _ INTERFACESAFE_FOR_UNTRUSTED_DATA ' set and return supported object safety features... If (riid <> 0) Then ' validate pointer to interface id CopyMemory rClsId, ByVal riid, Len(rClsId) ' copy interface guid to struct bIID = String$(MAX_GUIDLEN, 0) ' pre-allocate byte array Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN) ' get clsid from guid struct Rc = InStr(1, bIID, vbNullChar) - 1 ' look for trailing null char.s IID = Left$(UCase(bIID), Rc) ' trim extra nulls and convert to upper-case for comparison 'WriteLog "Interface riid: " & IID ' write interface id to log(debugging only) Select Case IID Case IID_IDispatch '------------------------------------------------------------ ' IDispatch safety options requested '------------------------------------------------------------ pdwEnabledOptions = IIf(m_fSafeForScripting, INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0) Exit Sub ' return success '------------------------------------------------------------ Case IID_IPersistStorage, IID_IPersistStream, IID_IPersistPropertyBag '------------------------------------------------------------ ' is interface = IPersistStorage, IPersistStream or IPersistPropertyBag '------------------------------------------------------------ pdwEnabledOptions = IIf(m_fSafeForInitializing, INTERFACESAFE_FOR_UNTRUSTED_DATA, 0) Exit Sub ' return success '------------------------------------------------------------ Case Else ' unknown interface requested. '------------------------------------------------------------ Err.Raise E_NOINTERFACE ' safety options requested for interface are not supported. Exit Sub ' return error to host '------------------------------------------------------------ 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 ' function return code Dim rClsId As uGUID ' guid struct Dim IID As String ' interface id Dim bIID() As Byte ' byte array for interface id 'WriteLog "IObjectSafety_SetInterfaceSafetyOptions:: " & vbCrLf & _ " riid= " & CStr(riid) & vbCrLf & _ " dwOptionsSetMask= " & CStr(dwOptionsSetMask) & vbCrLf & _ " dwEnabledOptions= " & CStr(dwEnabledOptions) ' log info If (riid <> 0) Then ' validate pointer to interface id CopyMemory rClsId, ByVal riid, Len(rClsId) ' copy interface guid to struct bIID = String$(MAX_GUIDLEN, 0) ' pre-allocate byte array Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN) ' get clsid from guid struct Rc = InStr(1, bIID, vbNullChar) - 1 ' look for trailing null char.s IID = Left$(UCase(bIID), Rc) ' trim extra nulls and convert to upper-case for comparison 'WriteLog "Interface riid: " & IID ' write interface id to log(debugging only) Select Case IID Case IID_IDispatch '------------------------------------------------------------ If ((dwEnabledOptions And dwOptionsSetMask) <> INTERFACESAFE_FOR_UNTRUSTED_CALLER) Then 'WriteLog "Error - Unsupported Safety options have been requested..." Err.Raise E_FAIL ' error: safety options not supported on interface Exit Sub ' return HRESULT Else ' unsupported security options requested. If Not m_fSafeForScripting Then Rc = MsgBox("This Object Not Safe For Scripting." & vbCrLf & _ "Do You Wish To Make It Safe By Disabling The UnSafe Features?", _ vbYesNo Or vbQuestion, _ "This Dialog Is For Testing The IObjectSafety Interface") m_fMakeSafeForScripting = (Rc = vbYes) If Not m_fMakeSafeForScripting Then ' can object be made safe internally? Err.Raise E_FAIL ' object is still not safe for scripting. Exit Sub ' return HRESULT Else ' object can be made safe for scripting. Exit Sub ' return HRESULT End If Else ' object is safe for scripting Exit Sub ' return HRESULT End If End If '------------------------------------------------------------ Case IID_IPersistStorage, IID_IPersistStream, IID_IPersistPropertyBag ' is interface = IPersistStorage, IPersistStream or IPersistPropertyBag '------------------------------------------------------------ If ((dwEnabledOptions And dwOptionsSetMask) <> INTERFACESAFE_FOR_UNTRUSTED_DATA) Then Err.Raise E_FAIL ' error: safety options not supported on interface Exit Sub ' return HRESULT Else ' unsupported security option requested If Not m_fSafeForInitializing Then Err.Raise E_FAIL ' is this object safe for initializing? Exit Sub ' return HRESULT End If '------------------------------------------------------------ Case Else ' unknown interface requested. '------------------------------------------------------------ Err.Raise E_NOINTERFACE ' safety options requested for interface are not supported. Exit Sub ' return HRESULT '------------------------------------------------------------ End Select End If End Sub '---------------------------------------------------------------------------------------------------- Public Property Get Safe() As Boolean ' This property is safe for scripting and may be safely used ' by any host container. '------------------------------------------------------------ 'WriteLog "Property Get Safe: has been called. This property is always safe for scripting." Safe = m_Safety ' return boolean data value End Property '---------------------------------------------------------------------------------------------------- Public Property Let Safe(ByVal IsSafe As Boolean) ' This property is safe for scripting and may be safely used ' by any host container. '------------------------------------------------------------ 'WriteLog "Property Let Safe: has been called. This property is always safe for scripting." m_Safety = IsSafe ' set boolean data value End Property '---------------------------------------------------------------------------------------------------- Public Property Get UnSafe() As Boolean ' This property is unsafe for scripting but may be requested ' to be safe by the host container. If safety is required then ' this function needs to be disabled when it gets called. '------------------------------------------------------------ If m_fMakeSafeForScripting Then ' is object required to be safe? Err.Raise E_FAIL ' error: safety options not supported on interface Exit Property ' return Else 'WriteLog "Property Get UnSafe: has been called. This property is not always safe for scripting." Safe = m_Safety ' return boolean data value End If End Property '---------------------------------------------------------------------------------------------------- Public Property Let UnSafe(ByVal IsSafe As Boolean) ' This property is unsafe for scripting but may be requested ' to be safe by the host container. If safety is required then ' this function needs to be disabled when it gets called. '------------------------------------------------------------ If m_fMakeSafeForScripting Then ' is object required to be safe? Err.Raise E_FAIL ' error: safety options not supported on interface Exit Property ' return Else 'WriteLog "Property Let UnSafe: has been called. This property is not always safe for scripting." m_Safety = IsSafe ' set boolean data value End If End Property '------------------------------------------------------------------- 'End '-------------------------------------------------------------------