COM InProcServer для MSSQL

[Дед Пахом]

Я всё не решался спросить, а C55 обязательно использовать?

[WadimZapara]

Есть тестовая победа.
В режиме "только один объект можно создавать" - работает.
Объект может:
- по дисковому имени прочесть структуру кларион-файла
- выдать её (количество ключей, полей, затем по номерам - всё о них, метки, типы, размеры, DIM-ы)
- OPEN, CLOSE
- считать поле
- записать поле
- SET, GET, NEXT, PUT, PREVIOUS, POINTER, RECORDS, ADD.

Спасибо: Михаилу Дуге, Олегу Руденко.

Единственное ограничение - которое пока не знаю как победить: только один объект (файл) в один момент в одном процессе.
Причина - при попытке разместить в классе интерфейса объявления указателей на переменные других классов, с последующим выполнением NEW (при создании интерфейса), DISPOSE (при убиении интерфейса) - получаю стойкий ACCESS VIOLATION и вылет клиента (испытывал в Excel).

Это наблюдается даже если все операторы NEW, DISPOSE, а также обращения к этим переменным закомментарены.
То есть, достаточно факта одного объявления - и вылет обеспечен.
Этого понять не могу.

Пока вышел из положения, объявив такие переменные глобально с атрибутом STATIC.
Но это, увы, приводит к указанному ограничению.

Мысли / предложения / замечания ?

[Дед Пахом]

В C8 всё работает - создание/удаление/использование других типов, одновременная работа с несколькими инстанциями одного COM-класса, работа в разных потоках. Только что проверил на примере Math.

[WadimZapara]

Выявлен и побеждён Баг. Опишу выявленную ошибку клары.
Класс объявлен так.

Код: Выделить всё

ClarionFile                     CLASS,IMPLEMENTS(IClarionFile),TYPE
Psewdo                            Long,PROTECTED
MyObj                             LONG,PROTECTED
m_lRef                            LONG,PROTECTED
m_ptinfo                          &ITypeInfo,PROTECTED

Construct                         PROCEDURE()
Destruct                          PROCEDURE()
...
Method1                           PROCEDURE,HRESULT,PROC
...
                                END

Конструктор и деструктор:

Код: Выделить всё

ClarionFile.Construct           PROCEDURE()
HR                              HRESULT
lptinfo                         LONG
  CODE;  SELF.m_lRef=0;  InterlockedIncrement(g_lObjs);
  HR=LoadTypeInfo(ADDRESS(G.lptinfo),ADDRESS(IID_IClarionFile))
  IF HR=S_OK THEN SELF.m_ptinfo &= (lptinfo).
  SELF.Psewdo = 123
  STOP('Constructor. Psewdo='& SELF.Psewdo &', ADDR of Psewdo='& ADDRESS(SELF.Psewdo))

ClarionFile.Destruct            PROCEDURE()
  CODE;  IF ~(SELF.m_ptinfo &= NULL) THEN  SELF.m_ptinfo.Release().
  STOP('Destructor. Psewdo='& SELF.Psewdo &', ADDR of Psewdo='& ADDRESS(SELF.Psewdo))
  InterlockedDecrement(g_lObjs)

Здесь - как мы и ожидаем, в обоих случаях на стопе получаем результат: 123 и какой-то адрес, например 128346124

Но вот другие методы, например:

Код: Выделить всё

Method1                           PROCEDURE !,HRESULT,PROC
  CODE
  STOP('Psewdo='& SELF.Psewdo &', ADDR of Psewdo='& ADDRESS(SELF.Psewdo) &|
       ', MyObj='& SELF.MyObj &', ADDR of MyObj='& ADDRESS(SELF.MyObj))

- представляют нам нечто неожиданное (при том, что нигде более в коде нет присваивания переменным SELF.Psewdo и SELF.MyObj).
Так вот результат: Psewdo=0, ADDR of Psewdo=128346120, MyObj=123, ADDR of MyObj=128346124

Ну а если MyObj это не LONG, а указатель на объект класса - то программный сбой типа ACCESS VIOLATION - гарантирован.

Вышел из положения таким образом: в конструкторе (и деструкторе) настраиваю (и уничтожаю) объекты через переменную Psewdo, а в других методах - переменную MyObj, объявленную в описании сразу за Psewdo.

Замечание:
Одинаково и "нормально" ведут себя по отношению к переменным Construct, Destruct, Release
Все же методы, создаваемые для пользователя COM-объекта типа Method1 получают адрес переменной со смещением -4.

[Дед Пахом]

Всё-таки я решил проверить всё это на C55... Перво-наперво, win32.lib от C8 избавляет от ошибки с DllCanUnloadNow. Второе, включил реализации PutReg и LongToHex прямо в код math.clw (простое подключение include('c55util.inc') почему-то не работает). Всё собралось, всё зарегистрировалось (regsvr32.exe), за исключением некритичной ошибки при регистрации метода MathEx.Sqrt (не стал разбираться с ошибкой, и выяснилось, что Sqrt всё равно правильно корень извлекает ) Добавил Psewdo в класс, стопы в конструктор/деструктор и все методы - везде возвращает начальное значение (у меня оно равно 456), и адрес везде один и тот же.
Резюме:
C55 создаёт вполне рабочие COM объекты.

[WadimZapara]

Михаил, спасибо за участие.
PUTREG в С55 возвращает BYTE (успех/неудача), в отличие от C6 и выше, где возвращается LONG (код ошибки).
LongToHex (а также PathSplit) просто отсутствует в C55.
Но дело не в этих мелочах.

Я собрал заново без подключения каких-либо доп.классов, не реализуя ни один метод из объявленных, за исключением одного, в реализации которого STOP(ADDRESS(SELF:Psewdo)).
И тот же оператор в конструкторе.
Проверял в EXCEL-е

Код: Выделить всё

Sub tst()
  Dim o As Object, e As Long
  Set o = CreateObject("Clarion.File")
  e = o.ErrCode
  Set o = Nothing
End Sub

Результат у меня прежний: в конструкторе 54218720, а в методе 54218716.
Ранее - при программировании таких проблем никогда не встречал. Причину понять не могу.
Приходит на ум только одно - что реализация какой-то функции в C55 отличается от её реализации в старших версиях (как PutReg), прототип похож, но не соответствует и в стек в одном из случаев кладётся лишний LONG.
Но где это...? - Может позже найду...
Однако, с обманом, описанным ранее, у меня тоже получился вполне рабочий COM-сервер, позволяющий создать несколько объектов - файлов DAT и работать с ними - читать, писать, искать - то, что и было целью.
НО ! В MSSQL объект работать не стал. Я так понял - ему (MSSQL) мало COM-интерфейса, ему подавай OLE (только sp_OACreate и sp_OADestroy отрабатывают без ошибки).

Буду превращать свой COM-сервер в OLE-сервер. Не поделитесь ли простым (минимальным) примером ?

[Дед Пахом]

В C55 PutReg возвращает то, что вернул RegSetValueEx: 0 (ERROR_SUCCESS) / не 0 (код ошибки, правда только младший её байт).
OLE сервера не делал, помочь не смогу. А рабочий пример Math ради бога, если нужен.

[WadimZapara]

Добавил протоколирование в файл.
Выяснил, что Excel и MSSQL по-разному осуществляют работу с COM-объектом.
КОД (слева VB-Excel, справа T-SQL MSSQL)

Код: Выделить всё

  Dim o As Object, e As Long               !DECLARE @hr int, @o int, @e int, @src varchar(255), @descr varchar(255)
  Set o = CreateObject("Clarion.File")     !EXEC @hr = sp_OACreate 'Clarion.File', @o OUT
  e = o.ErrCode                            !EXEC @hr = sp_OAMethod @o, 'ErrCode', @e OUT
                                           !IF @hr <> 0 BEGIN EXEC sp_OAGetErrorInfo @o, @src OUT, @descr OUT SELECT CONVERT(binary(4), @hr) AS КодОшибки,  @src AS Источник, @descr AS Описание END
  Set o = Nothing                          !EXEC sp_OADestroy @o

вызывает разное исполнение, а именно:
- в случае Excel отрабатывает CONSRTUCT, дважды запрашивается интерфейс IUnknown, затем IDispatch, после чего следует вызов IDispatch:GetIDsOfNames, затем IDispatch:Invoke, затем SELF:ErrCode, далее SELF:Release.
- в случае MSSQL отрабатывает CONSRTUCT, дважды запрашивается интерфейс IUnknown, затем IDispatch, после чего следует вызов IDispatch::GetTypeInfo, затем запрашивается интерфейс ошибки IErrorInfo, далее SELF:Release. При этом - OBJECT.TLB ОСТАЁТСЯ в памяти MSSQL-сервера (не выгружается).

Итак, вновь вопрос: с какой стати такое поведение?

Почитал MSDN про IDispatch, вычитал, что GetTypeInfo описыватся:

Код: Выделить всё

HRESULT GetTypeInfo(unsigned int iTInfo, LCID lcid, ITypeInfo FAR* FAR* ppTInfo);
HRESULT GetIDsOfNames(REFIID riid, OLECHAR FAR* FAR* rgszNames, unsigned int cNames, LCID lcid, DISPID FAR* rgDispId);
HRESULT Invoke(DISPID dispIdMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS FAR* pDispParams, VARIANT FAR* pVarResult, EXCEPINFO FAR* pExcepInfo, unsigned int FAR* puArgErr);

Посмотрел описание в кларе (svcomdef.inc):

Код: Выделить всё

IDispatch               interface(IUnknown),com
...
GetTypeInfo               procedure(long iTInfo, long lcid, long ppTInfo),HRESULT
GetIDsOfNames             procedure(long riid, long prgszNames, long cNames, long lcid, long prgDispId),HRESULT
Invoke                    procedure(long dispIdMember, long riid, long lcid, short wFlags, |
                                    long pDispParams, long pVarResult, long pExcepInfo, long puArgErr),HRESULT
                        end

... и перестал понимать - судя по описанию MSDN - параметры со * - должны бы быть ссылками, т.е. с описанием *Long...

[Дед Пахом]

... и перестал понимать - судя по описанию MSDN - параметры со * - должны бы быть ссылками, т.е. с описанием *Long...

Если long без *, то туда просто надо передавать ADDRESS().

Тоже попробовал вызывать из T-SQL. sp_OACreate/sp_OADestroy работают без проблем, а вот sp_OAMethod возвращает 0xc0000005 (EXCEPTION_ACCESS_VIOLATION). Идей нет.

[WadimZapara]

именно так.
но именно после попытки MSSQL вызвать MyObject.GetTypeInfo (LONG iTInfo,LONG lcid,LONG ppTInfo)
с параметрами iTInfo = 0, lcid = 1024, а в ppTInfo какое-то маленькое число типа 1230120

Код: Выделить всё

MyObject.GetTypeInfo         PROCEDURE(LONG iTInfo,LONG lcid,LONG ppTInfo)
  CODE
  ppTInfo=0
  IF iTInfo <> 0 THEN RETURN DISP_E_BADINDEX.
  IF SELF.m_ptinfo.AddRef() END
  ppTInfo=ADDRESS(SELF.m_ptinfo)
  RETURN S_OK

но поскольку описание ppTInfo - без *, то что будет при операции ppTInfo=ADDRESS(SELF.m_ptinfo) ???
вот здесь, по-видимому, и происходит access violation
куда надо адрес интерфейса библиотеки типов не попадает, а счётчик ссылок уже увеличен при SELF.m_ptinfo.AddRef()
в итоге MSSQL временно не падает (есть запас прочности), исполнение прекращает, а выгрузить TLB не может

параметр в MSDN описан как ITypeInfo FAR* FAR* ppTInfo, то есть адрес указателя на интерфейс, по идее по этому адресу и нужно записать указатель на интерфейс, типа
memcpy(ppTInfo, ADDRESS(SELF.m_ptinfo), 4)
нет ?

ЗЫ: по поводу PutReg - мы оба правы: в тексте функции (в c55util.clw) идёт возврат ошибки, а в тексте объявления (в c55util.inc) так:
PutReg( LONG hKey, STRING sSubKeyPath, STRING sValueName, STRING sValue, LONG lType=1 ), BYTE

[Дед Пахом]

Вставил вывод в DebugView (OutputDebugString), и ничего не выводится, если из Management Studio скрипт запускаю... Даже из конструктора. Ничего не понимаю.

[WadimZapara]

в прошлом посте наврал (по памяти писал), ppTInfo при входе в процедуру = 0

[Дед Пахом]

из VBScript всё прекрасно работает:

Код: Выделить всё

set oMath = CreateObject("Clarion.Math")
dim Res
Res = oMath.Subtract(5, 2)
MsgBox "5-2=" & Res

Но что интересно, из методов IDispatch вызывается только Invoke, никаких GetTypeInfo скрипт не дёргает.
MSSQL не дёргает вообще ничего, ни ctor/dtor, ни методы IUnknown/IDispatch. Такое ощущение, что sp_OACreate просто считывает информацию из реестра, а дальнейшие попытки вызвать sp_OAMethod просто не находят dll или не могут её загрузить.

[WadimZapara]

У меня запротоколировалось так:
/у меня QueryInterface сначала вызывает AddRef, а затем пишет протокол,
а AddRef и Release сначала изменяют счётчик, а потом пишут протокол/

Construct
-AddRef (1)-QueryInterface (IUnknown)
-AddRef (2)
-Release (1)
-AddRef (2)-QueryInterface (IUnknown)
-Release (1)
-AddRef (2)-QueryInterface (IDispatch)
-Release (1)
-AddRef (2)
-AddRef (3)
-Release (2)
-GetTypeInfo(iTinfo=0, lcid=1024, ppTinfo=0)
-Release (1)
-Release (0)-Destruct

впечатление, что либо он (MSSQL) получает нужную ссылку
а далее пытается узнать о совместимости типов, но это у него не получается (а может хочет агрегировать?)
Excel (он тоже VB) вызова GetTypeInfo не делает, а после получения IDispatch сразу зовёт GetIDsOfNames и Invoke, и запрошенный метод.

[WadimZapara]

Испытал изменения согласно высказанным выше предположениям:

1. Объявление прототипа GetTypeInfo в интерфейсе IDispatch и и метода его реализации приведено в соответствие с информацией MSDN.
(Основанием явилось следующее:
- согласно MSDN, ppTInfo - это адрес указателя на интерфейс библиотеки типов, выходной параметр;
- рассуждения о работе компилятора при описании параметров, передаваемых по ссылке и по значению /ссылка - в стек помещается адрес переданной переменной, с ним и работа; значение - в стек копия и с адресом копии работа; по выходу из процедуры - она сама и чистит стек/;
- при логгировании адрес этой переменной при исполнении GetTypeInfo больше адреса локальной переменной, объявленной в теле процедуры, а значит, она помещена в стек ниже указанной локальной переменной, то есть, мы работаем с копией переданного параметра)

Код: Выделить всё

   GetTypeInfo (long iTInfo, long lcid, *LONG ppTInfo),HRESULT

2. В реализацию процедуры фабрики CreateInstance добавил проверку на запрос об агрегировании с отказом в такой возможности
(Основание
- непонятные попытки MSSQL наращивать счётчик ссылок на объект
- ранее я уже пытался сделать изменения (1), но без (2) - положительного результата не достиг, хотя, может быть, эксперимент не был чистым - MSSQL я не рестартовал после возникновения ошибки доступа, в связи с которой TLB оставалась загруженной в память MSSQL /выявлено с помощью ProcessExplorer от SysInternals/)

Код: Выделить всё

ClarionFileCF.CreateInstance    PROCEDURE(LONG pUnkOuter,LONG riid,*LONG ppvObject)
pClarionFile                    &ClarionFile
hr                              HRESULT
  CODE
  ppvObject=0
  IF pUnkOuter THEN 
    hr = CLASS_E_NOAGGREGATION
  ELSE
    pClarionFile &= NEW(ClarionFile)
    If (pClarionFile &= NULL) Then
      hr = E_OUTOFMEMORY
    Else
      hr = pClarionFile.QueryInterface(riid,ppvObject)
      if hr <> S_OK then  DISPOSE(pClarionFile).
    End !If
  END !IF
  RETURN hr

ИТОГ: MSSQL исполняет методы объекта, как того и требовалось.

ЗЫ: Михаил, не стоит ли внести аналогичные изменения в твой замечательный продукт?
Завтра оттестирую в полном объёме и отпишусь.