Пишем GetIdsOfNames
В методе GetIdsOfNames мы должны проверить наличие запрошенного свойства и вернуть адрес его структуры TPropInfo, если такое свойство найдено.
Свойства компонентов VCL
|
Code: |
|
function TVCLProxy.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; var S: String; Info: PPropInfo; begin Result := S_OK; // Получаем имя функции или свойства S := PNamesArray(Names)[0]; // Проверяем, есть ли VCL свойство с таким-же именем Info := GetPropInfo(FOwner.ClassInfo, S); if Assigned(Info) then begin // Свойство есть, возвращаем в качестве DispId // адрес структуры PropInfo PDispIdsArray(DispIds)[0] := Integer(Info); end |
Дополнительные функции
Дополним нашу реализацию возможностью вызова некоторых дополнительных функций:
Controls
Для наследников TWinControl возвращает ссылку на дочерний компонент с именем или индексом, заданным в параметре
Count
Для компонентов TWinControl – возвращает количество дочерних компонентов
Для TCollection – возвращает количество элементов
Для TStrings – возвращает количество строк
Add
Для компонентов TWinControl – создает дочерний компонент
Для TCollection – добавляет элемент в коллекцию
Для TStrings – добавляет строку
HasProperty
Возвращает истину, если у объекта есть свойство с заданным именем
Для этого дополним метод GetIdsOfNames следующим кодом:
|
Code: |
|
else // Нет такого свойства, проверяем, не имя ли это // одной из определенных нами функций if CompareText(S, 'CONTROLS') = 0 then begin if (FOwner is TWinControl) then PDispIdsArray(DispIds)[0] := DISPID_CONTROLS else Result := DISP_E_UNKNOWNNAME; end else if CompareText(S, 'COUNT') = 0 then begin if (FOwner is TCollection) or (FOwner is TStrings) or (FOwner is TWinControl) then PDispIdsArray(DispIds)[0] := DISPID_COUNT else Result := DISP_E_UNKNOWNNAME; end else if CompareText(S, 'ADD') = 0 then begin Result := S_OK; if (FOwner is TCollection) or (FOwner is TStrings) or (FOwner is TWinControl) then PDispIdsArray(DispIds)[0] := DISPID_ADD else Result := DISP_E_UNKNOWNNAME; end else if CompareText(S, 'HASPROPERTY') = 0 then PDispIdsArray(DispIds)[0] := DISPID_HASPROPERTY else Result := DISP_E_UNKNOWNNAME; end; |
Константы DISPID_CONTROLS, DISPID_COUNT и т.д. определены как целые числа из диапазона 1 … 1 000 000. Это вполне безопасно, т.к. адрес структуры TPropInfo никак не может оказаться ниже 1 Мб
Пишем Invoke
Первая часть задачи выполнена – мы проинформировали OLE о наличии в нашем сервере автоматизации поддерживаемых функций. Теперь необходимо реализовать метод Invoke для выполнения этих функций. Из соображений модульности Invoke выполняет подготовительную работу со списком параметров и вызывает метод DoInvoke, в котором мы осуществляем трансляцию DispID в обращения к методам класса VCL.
В методе используются три служебных функции:
CheckArgCount – проверяет количество переданных аргументов
_ValidType – проверяет соответствие аргумента с заданным индексом заданному типу
_IntValue – получает целое число из аргумента с заданным индексом
|
Code: |
|
function TVCLProxy.DoInvoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var dps: TDispParams; pDispIds: PDispIdList; VarResult, ExcepInfo, ArgErr: Pointer ): HResult; var S: String; Put: Boolean; I: Integer; P: TPersistent; B: Boolean; OutValue: OleVariant; begin Result := S_OK; case DispId of |
Для функции Controls мы должны проверить, что передан один параметр. Если он строковый – дочерний компонент ищется по имени, иначе – по индексу. Если компонент найден – вызывается функция FScriptControl.GetProxy, которая проверяет, есть ли уже «представитель» у этого компонента, при необходимости создает его и возвращает интерфейс IDispatch. Такой алгоритм необходим для корректной работы оператора VBScript Is, который сравнивает две ссылки на объект и выдает истину, если это один и тот же объект, например:
|
Code: |
|
Dim A Dim B
Set A = C Set B = C
If A is B Then ... |
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!