Skip to content

Instantly share code, notes, and snippets.

@zamabuvaraeu

zamabuvaraeu/Классы, интерфейсы и наследование.md

Last active January 4, 2023 12:06
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save zamabuvaraeu/982eff1ee5e2797a7f0153da1e49c22a to your computer and use it in GitHub Desktop.
Save zamabuvaraeu/982eff1ee5e2797a7f0153da1e49c22a to your computer and use it in GitHub Desktop.
Download ZIP
Пример простого COM‐класса вручную
Raw
Классы, интерфейсы и наследование.md

COM, интерфейсы, классы, наследование и объекты

На простом примере покажем, как создать COM-объект, интерфейсы и наследование в ручном режиме.

Новые типы данных

Нам нужно будет ввести несколько новых типов данных: HRESULT и GUID. Обычно эти типы данных не объявляют напрямую, а подключают заголовочный файл windows.bi.

HRESULT

HRESULT содержит информацию о результате вызова функции. Это обычное 32‐битное число со знаком:

Type HRESULT As LONG

GUID, IID, CLSID

GUID — это беззнаковое целое 128‐битное число. Ничего таинственного и сверхъестественного. Так как встроенных 128‐битных чисел у нас нет, будем эмулировать такие числа с помощью структуры:

Type _GUID
    Data1 As ULong
    Data2 As UShort
    Data3 As UShort
    Data4(0 To 7) As UByte
End Type

Type GUID As _GUID
Type IID As GUID
Type CLSID As GUID

Такие числа генерируются по специальному алгоритму и статистически уникальны.

Интерфейсы

Интерфейсы представляют собой тип данных, хранящий указатель на таблицу виртуальных функций.

Таблица виртуальных функций — это структура с указателями на функции. Функции виртуальны, потому что указатели на них задаются не на стадии написания программы, а во время выполнения.

Объявим два интерфейса: IMath и IString. Первый будет складывать числа, второй приводить внутреннее поле к строке.

Интерфейс IMath

' Предварительное объявление
Type IMath As IMath_

' Идентификатор интерфейса IMath
Extern IID_IMath Alias "IID_IMath" As Const IID

' Таблица виртуальных функций
Type IMathVtbl
	QueryInterface As Function(ByVal this As IMath Ptr, ByVal riid As REFIID, ByVal ppvObject As Any Ptr Ptr)As HRESULT
	AddRef As Function(ByVal this As IMath Ptr)As ULONG
	Release As Function(ByVal this As IMath Ptr)As ULONG
	Add As Function(ByVal this As IMath Ptr, ByVal Value As Integer)As HRESULT
End Type

' Собственно, сама декларация интерфейса — это указатель на таблицу виртуальных функций
Type IMath_
	lpVtbl As IMathVtbl Ptr
End Type

Интерфейсы данных не содержат, поэтому структура IMath_ состоит только из одного поля.

Интерфейс IString

Type IString As IString_

' Идентификатор интерфейса IString
Extern IID_IString Alias "IID_IString" As Const IID

Type IStringVtbl
	QueryInterface As Function(ByVal this As IString Ptr, ByVal riid As REFIID, ByVal ppvObject As Any Ptr Ptr)As HRESULT
	AddRef As Function(ByVal this As IString Ptr)As ULONG
	Release As Function(ByVal this As IString Ptr)As ULONG
	ToString As Function(ByVal this As IString Ptr, ByVal pResult As String Ptr)As HRESULT
End Type

Type IString_
	lpVtbl As IStringVtbl Ptr
End Type

Унаследованный класс

Интерфейсы не предоставляют реализации функций, а только декларируют их существование. Экземпляр интерфейса не следует создавать, следует создавать унаследованный от интерфейса класс, реализующий все объявленные функции.

Так как всё объектно‐ориентированное программирование мы выполняем вручную, то наш класс в коде будет выражен в виде структуры, и наследование — это добавление указателей на таблицы виртуальных функций:

' Идентификатор нашего класса
Extern CLSID_MATHSTRING Alias "CLSID_MATHSTRING" As Const CLSID

Type MathString
	' Указатели на таблицы функций
	lpMathVtbl As Const IMathVtbl Ptr
	lpStringVtbl As Const IStringVtbl Ptr
	' Счётчик ссылок
	ReferenceCounter As UInteger
	' Данные
	Value As Integer
End Type

Реализация функций

Реализуем функции каждого из интерфейсов. Первые три функции у каждого из интерфейсов — QueryInterface, AddRef и Release — общие, они унаследованы от интерфейса IUnknown. Их не нужно будет реализовывать дважды.

Функция QueryInterface

Здесь мы должны проверить какой интерфейс запрашивают у нашего объекта, и если мы такой интерфейс поддержимаем, то возвращаем указатель на таблицу виртуальных функций:

Function MathStringQueryInterface(ByVal this As MathString Ptr, ByVal riid As REFIID, ByVal ppv As Any Ptr Ptr)As HRESULT
	
	If IsEqualIID(@IID_IMath, riid) Then
		*ppv = @this->lpMathVtbl
	Else
		If IsEqualIID(@IID_IString, riid) Then
			*ppv = @this->lpStringVtbl
		Else
			If IsEqualIID(@IID_IUnknown, riid) Then
				*ppv = @this->lpMathVtbl
			Else
				' От этого интерфейса мы не унаследованы
				*ppv = NULL
				Return E_NOINTERFACE
			End If
		End If
	End If
	
	' По правилам подсчёта ссылок всегда увеличиваем счётчик перед возвратом
	MathStringAddRef(this)
	
	Return S_OK
	
End Function

Функция AddRef

Здесь мы просто увеличиваем счётчик ссылок:

Function MathStringAddRef(ByVal this As MathString Ptr)As ULONG
	
	this->ReferenceCounter += 1
	
	Return 1
	
End Function

Функция Release

Уменьшаем счётчик ссылок. Если счётчик ссылок достиг нуля, значит на нас никто не ссылается, и объект можно уничтожить:

Function MathStringRelease(ByVal this As MathString Ptr)As ULONG
	
	this->ReferenceCounter -= 1
	
	If this->ReferenceCounter Then
		Return 1
	End If
	
	' Удаляем объект
	Deallocate(this)
	
	Return 0
	
End Function

Функция Add

Function MathStringAdd(ByVal this As MathString Ptr, ByVal Value As Integer)As HRESULT
	
	' Складываем значение которое нам передали с внутренним полем
	this->Value += Value
	
	Return S_OK
	
End Function

Функция ToString

Function MathStringToString(ByVal this As MathString Ptr, ByVal pResult As String Ptr)As HRESULT
	
	' Преобразуем в строку и возвращаем
	Dim sValue As String = Str(this->Value)
	
	*pResult = sValue
	
	Return S_OK
	
End Function

Функции преобразования из интерфейса в объект

Определим макрос, который возвращает указатель на начало объекта от указателя на его поле:

' pObject — указатель на поле объекта
' ClassName — название класса
' FieldName — название поля класса, от которого взят указатель
#define ContainerOf(pObject, ClassName, FieldName) CPtr(ClassName Ptr, (CInt(pObject) - OffsetOf(ClassName, FieldName)))

Теперь нам нужно создать функции, которые по указателю на интерфейс будут восстанавливать указатель на объект, и вызывать наши функции.

IMath

Function IMathQueryInterface(ByVal this As IMath Ptr, ByVal riid As REFIID, ByVal ppvObject As Any Ptr Ptr)As HRESULT
	Return MathStringQueryInterface(ContainerOf(this, MathString, lpMathVtbl), riid, ppvObject)
End Function

Function IMathAddRef(ByVal this As IMath Ptr)As ULONG
	Return MathStringAddRef(ContainerOf(this, MathString, lpMathVtbl))
End Function

Function IMathRelease(ByVal this As IMath Ptr)As ULONG
	Return MathStringRelease(ContainerOf(this, MathString, lpMathVtbl))
End Function

Function IMathAdd(ByVal this As IMath Ptr, ByVal Value As Integer)As HRESULT
	Return MathStringAdd(ContainerOf(this, MathString, lpMathVtbl), Value)
End Function

IString

Function IStringQueryInterface(ByVal this As IString Ptr, ByVal riid As REFIID, ByVal ppvObject As Any Ptr Ptr)As HRESULT
	Return MathStringQueryInterface(ContainerOf(this, MathString, lpStringVtbl), riid, ppvObject)
End Function

Function IStringAddRef(ByVal this As IString Ptr)As ULONG
	Return MathStringAddRef(ContainerOf(this, MathString, lpStringVtbl))
End Function

Function IStringRelease(ByVal this As IString Ptr)As ULONG
	Return MathStringRelease(ContainerOf(this, MathString, lpStringVtbl))
End Function

Function IStringToString(ByVal this As IString Ptr, ByVal Value As Integer)As HRESULT
	Return MathStringToString(ContainerOf(this, MathString, lpStringVtbl), Value)
End Function

Таблицы виртуальных функций

Создаём таблицы функций, и заполняем их указателями на наши реальные функции.

IMathVtbl

' Таблицы функций
Extern GlobalIMathVtbl As Const IMathVtbl

Dim GlobalIMathVtbl As Const IMathVtbl = Type( _
	@IMathQueryInterface, _
	@IMathAddRef, _
	@IMathRelease, _
	@IMathAdd _
)

IStringVtbl

Extern GlobalIStringVtbl As Const IStringVtbl

Dim GlobalIStringVtbl As Const IStringVtbl = Type( _
	@IStringQueryInterface, _
	@IStringAddRef, _
	@IStringRelease, _
	@IStringToString _
)

Создание объекта

Теперь нам необходима функция, которая будет создавать объект и возвращать указатель на интерфейс:

Function CreateInstance(ByVal rclsid As REFCLSID, ByVal riid As REFIID, ByVal ppv As Any Ptr Ptr)As HRESULT
	
	If IsEqualCLSID(@CLSID_MATHSTRING, rclsid) Then
		Dim pObject As MathString Ptr = Allocate(SizeOf(MathString))
		If pObject = NULL Then
			' Не можем выделить память для объекта, возвращаем ошибку
			*ppv = NULL
			Return E_OUTOFMEMORY
		End If
		
		' Инициализация объекта
		pObject->lpMathVtbl = @GlobalIMathVtbl
		pObject->lpStringVtbl = @GlobalIStringVtbl
		pObject->ReferenceCounter = 0
		pObject->Value = 0
		
		Dim hr As HRESULT = MathStringQueryInterface(pObject, riid, ppv)
		If FAILED(hr) Then
			' Запрашиваемый интерфейс не поддерживается, удаляем объект
			*ppv = NULL
			Deallocate(pObject)
		End If
		
		Return hr
	End If
	
	' Класс не поддерживается, возвращаем ошибку
	*ppv = NULL
	Return CLASS_E_CLASSNOTAVAILABLE
	
End Function

Пример

У нас уже всё есть: определения интерфейсов и реализованный унаследованный от них класс. Нам осталось создать объект:

' Создаём объект класса и получаем указатель на интерфейс IMath

Dim pMath As IMath Ptr = Any
Dim hrCreate As HRESULT = CreateInstance(@CLSID_MATHSTRING, @IID_IMath, @pMath)
If FAILED(hrCreate) Then
	' Ошибка, выводим на распечать и выходим
	Print Hex(hrCreate)
	End(1)
End If

' Вызываем функцию интерфейса
pMath->lpVtbl->Add(pMath, 265)

' Запрашиваем интерфейс IString
Dim pString As IString Ptr = Any
Dim hrQuery As HRESULT = pMath->lpVtbl->QueryInterface(pMath, @IID_IString, @pString)
If FAILED(hrQuery) Then
	' Ошибка: запрошенный интерфейс не поддерживается, выводим на экран и выходим
	Print Hex(hrQuery)
	End(1)
End If

' Теперь вызываем функцию интерфейса ToString
Dim strValue As String = Any
pString->lpVtbl->ToString(pString, strValue)

' Выводим строку на дисплюй
Print strValue

' Очистка:

' Интерфейс IString больше не нужен, делаем Release
pString->lpVtbl->Release(pString)

' Интерфейс IMath больше не нужен, делаем Release
pMath->lpVtbl->Release(pMath)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment