1 | 'Classes/ActiveBasic/ComClassBase.ab
|
---|
2 |
|
---|
3 | Namespace ActiveBasic
|
---|
4 | Namespace COM
|
---|
5 |
|
---|
6 | /*!
|
---|
7 | @biref IUnkown実装用の基底クラス
|
---|
8 | @date 2008/08/02
|
---|
9 | @auther Egtra
|
---|
10 | */
|
---|
11 | Class ComClassBase
|
---|
12 | Implements IUnknown, InterfaceQuerable
|
---|
13 | Public
|
---|
14 | Virtual Function AddRef() As DWord
|
---|
15 | If refCount = 0 Then
|
---|
16 | handle = System.Runtime.InteropServices.GCHandle.Alloc(This)
|
---|
17 | End If
|
---|
18 | refCount++
|
---|
19 | AddRef = refCount
|
---|
20 | End Function
|
---|
21 |
|
---|
22 | Virtual Function Release() As DWord
|
---|
23 | refCount--
|
---|
24 | Release = refCount
|
---|
25 | If refCount = 0 Then
|
---|
26 | handle.Free()
|
---|
27 | handle = Nothing
|
---|
28 | End If
|
---|
29 | End Function
|
---|
30 |
|
---|
31 | /*!
|
---|
32 | @brief IUnkown.QueryInterfaceの実装
|
---|
33 | このメソッドはオーバーライドせず、代わりにQueryInterfaceImplをオーバーライドすること。
|
---|
34 | */
|
---|
35 | Virtual Function QueryInterface(ByRef iid As IID, ByRef obj As Any) As HRESULT
|
---|
36 | If VarPtr(obj) = 0 Then
|
---|
37 | QueryInterface = E_POINTER
|
---|
38 | Else
|
---|
39 | Try
|
---|
40 | Dim pv As VoidPtr
|
---|
41 | QueryInterface = QueryInterfaceImpl(iid, pv)
|
---|
42 | Set_LONG_PTR(VarPtr(obj), pv As LONG_PTR)
|
---|
43 | Exit Function
|
---|
44 | Catch e As System.Exception
|
---|
45 | QueryInterface = e.ErrorCode
|
---|
46 | If SUCCEEDED(QueryInterface) Then
|
---|
47 | QueryInterface = E_FAIL
|
---|
48 | End If
|
---|
49 | Catch
|
---|
50 | QueryInterface = E_FAIL
|
---|
51 | End Try
|
---|
52 | Set_LONG_PTR(VarPtr(obj), 0)
|
---|
53 | End If
|
---|
54 | End Function
|
---|
55 |
|
---|
56 | Virtual Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
|
---|
57 | If IsEqualIID(iid, IID_IUnknown) <> FALSE Then
|
---|
58 | pv = ObjPtr(This)
|
---|
59 | Else
|
---|
60 | Set_LONG_PTR(VarPtr(pv), 0 As LONG_PTR)
|
---|
61 | QueryInterfaceImpl = E_NOINTERFACE
|
---|
62 | Exit Function
|
---|
63 | End If
|
---|
64 | QueryInterfaceImpl = S_OK
|
---|
65 | AddRef()
|
---|
66 | End Function
|
---|
67 | Private
|
---|
68 | refCount As DWord
|
---|
69 | handle As System.Runtime.InteropServices.GCHandle
|
---|
70 | End Class
|
---|
71 |
|
---|
72 | Interface InterfaceQuerable
|
---|
73 | Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
|
---|
74 | End Interface
|
---|
75 |
|
---|
76 | /*!
|
---|
77 | @brief ComClassBaseを継承できないときのための移譲用クラス
|
---|
78 | @date 2008/08/02
|
---|
79 | @auther Egtra
|
---|
80 | */
|
---|
81 | Class ComClassDelegationImpl
|
---|
82 | Inherits ComClassBase
|
---|
83 | Public
|
---|
84 | Sub ComClassDelegationImpl(baseObject As InterfaceQuerable)
|
---|
85 | obj = baseObject
|
---|
86 | End Sub
|
---|
87 |
|
---|
88 | Override Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
|
---|
89 | QueryInterfaceImpl = super.QueryInterfaceImpl(iid, pv)
|
---|
90 | If SUCCEEDED(QueryInterfaceImpl) Then
|
---|
91 | Exit Function
|
---|
92 | End If
|
---|
93 | QueryInterfaceImpl = obj.QueryInterfaceImpl(iid, pv)
|
---|
94 | End Function
|
---|
95 | Private
|
---|
96 | obj As InterfaceQuerable
|
---|
97 | End Class
|
---|
98 |
|
---|
99 | End Namespace
|
---|
100 | End Namespace
|
---|