source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/COM/ComClassBase.ab@ 574

'Classes/ActiveBasic/ComClassBase.ab

Namespace ActiveBasic
Namespace COM

/*!
@biref IUnkown実装用の基底クラス
@date 2008/08/02
@auther Egtra
*/
Class ComClassBase
    Implements IUnknown, InterfaceQuerable
Public
    Virtual Function AddRef() As DWord
        If refCount = 0 Then
            handle = System.Runtime.InteropServices.GCHandle.Alloc(This)
        End If
        refCount++
        AddRef = refCount
    End Function

    Virtual Function Release() As DWord
        refCount--
        Release = refCount
        If refCount = 0 Then
            handle.Free()
            handle = Nothing
        End If
    End Function

    /*!
    @brief IUnkown.QueryInterfaceの実装
    このメソッドはオーバーライドせず、代わりにQueryInterfaceImplをオーバーライドすること。
    */
    Virtual Function QueryInterface(ByRef iid As IID, ByRef obj As Any) As HRESULT
        If VarPtr(obj) = 0 Then
            QueryInterface = E_POINTER
        Else
            Try
                Dim pv As VoidPtr
                QueryInterface = QueryInterfaceImpl(iid, pv)
                Set_LONG_PTR(VarPtr(obj), pv As LONG_PTR)
                Exit Function
            Catch e As System.Exception
                QueryInterface = e.ErrorCode
                If SUCCEEDED(QueryInterface) Then
                    QueryInterface = E_FAIL
                End If
            Catch
                QueryInterface = E_FAIL
            End Try
            Set_LONG_PTR(VarPtr(obj), 0)
        End If
    End Function

    Virtual Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
        If IsEqualIID(iid, IID_IUnknown) <> FALSE Then
            pv = ObjPtr(This)
        Else
            Set_LONG_PTR(VarPtr(pv), 0 As LONG_PTR)
            QueryInterfaceImpl = E_NOINTERFACE
            Exit Function
        End If
        QueryInterfaceImpl = S_OK
        AddRef()
    End Function
Private
    refCount As DWord
    handle As System.Runtime.InteropServices.GCHandle
End Class

Interface InterfaceQuerable
    Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
End Interface

/*!
@brief ComClassBaseを継承できないときのための移譲用クラス
@date 2008/08/02
@auther Egtra
*/
Class ComClassDelegationImpl
    Inherits ComClassBase
Public
    Sub ComClassDelegationImpl(baseObject As InterfaceQuerable)
        obj = baseObject
    End Sub

    Override Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
        QueryInterfaceImpl = super.QueryInterfaceImpl(iid, pv)
        If SUCCEEDED(QueryInterfaceImpl) Then
            Exit Function
        End If
        QueryInterfaceImpl = obj.QueryInterfaceImpl(iid, pv)
    End Function
Private
    obj As InterfaceQuerable
End Class

End Namespace
End Namespace