'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