www.clarionlife.net - Создание COM-сервера в Clarion

Главное меню

Ссылки

Авторизация (CB)

Счетчик

Создание COM-сервера в Clarion

Написал Дед Пахом

07.02.2006

Большая статья о создание COM-сервера

• Автор: Михаил Дуга
• Уровень знаний: профессионал
• Подразделы: нет
• Дата публикации: 03.07.2005

Чтобы в Clarion создать COM-сервер, надо в интернете найти толковую статью с примером создания COM, желательно на чистом C или C++, и перевести код один в один на Clarion, что я и сделал. К моему большому удивлению, всё сразу заработало (статья эта на rsdn.ru, что-то вроде "Создание COM-объектов").

Итак, высосем из пальца задачу: создать COM-интерфейс, способный выполнять основные арифметические действия с целыми числами: +,-,*,/. Воспользуемся для этого 6-й версией Клариона, т.к. в ней есть кое-какие зачатки для работы с COM.

Создадим проект math.pr и math.clw в нём:


  MEMBER

  MAP
  END

  INCLUDE('svcomdef.inc')

В файле svcomdef.inc продекларированы описания некоторых нужных нам вещей, например, базового интерфейса IUnknown, который будет родительским нашему интерфейсу IMath.


IMath         INTERFACE(IUnknown),COM,TYPE
_Add            PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
Subtract        PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
Multiply        PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
Divide          PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
              END

Атрибут COM в декларации интерфейса заставляет компилятор генерировать все методы интерфейса как имеющие паскалевский тип передачи параметров, поэтому явно писать ",PASCAL" возле каждого метода нет необходимости (все WinAPI функции обязаны иметь паскалевский тип передачи параметров).

Методы нашего интерфейса на входе получают 2 операнда, результат возвращают в третьем параметре по ссылке, а возвращаемое значение - это стандартный тип HRESULT (LONG), равный S_OK (0) при успешном завершении метода и что-нибудь другое при ошибке. Такое оформление интерфейса желательно, хотя и необязательно.

COM-интерфейсу требуется уникальный идентификатор, по которому он будет известен в операционной системе, GUID. Сгенерим этот GUID с помощью программы guidgen.exe и переведём в кларионовскую группу:


!// {FD594C17-CE75-4075-928F-E4D7C254DA06}
!static const GUID <> =
!{ 0xfd594c17, 0xce75, 0x4075, { 0x92, 0x8f, 0xe4, 0xd7, 0xc2, 0x54, 0xda, 0x6 } };
IID_IMath     GROUP
Data1           LONG(0FD594C17H)
Data2           SHORT(0CE75H)
Data3           SHORT(04075H)
Data4           STRING('<092h><08Fh><0E4h><0D7h><0C2h><054h><0DAh><06h>')
              END

INTERFACE в Кларионе - это просто набор методов. Нам надо написать класс, который эти методы реализует.


Math          CLASS,IMPLEMENTS(IMath),TYPE
m_lRef          LONG,PROTECTED

Construct       PROCEDURE()
Destruct        PROCEDURE()

QueryInterface  PROCEDURE(LONG riid,*LONG ppvObject),LONG
AddRef          PROCEDURE,LONG,PROC
Release         PROCEDURE,LONG,PROC

_Add            PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
Subtract        PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
Multiply        PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
Divide          PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG
              END

Методы QueryInterface, AddRef и Release унаследованы нашим IMath от IUnknown, их нам тоже надо реализовать. Свойство m_lRef - счётчик ссылок на интерфейс, он нужен для выгрузки из памяти, когда интерфейс никому не нужен (m_lRef=0).

Также заведём две глобальные переменные, которые помогут нам решить - можно ли выгрузить из памяти всю нашу библиотеку целиком или она ещё кем-то используется.


g_lObjs       LONG
g_lLocks      LONG

Приступим к реализации класса Math:


Math.Construct  PROCEDURE()
  CODE
  SELF.m_lRef=0
  InterlockedIncrement(g_lObjs)

Math.Destruct   PROCEDURE()
  CODE
  InterlockedDecrement(g_lObjs)

Функции InterlockedIncrement и InterlockedDecrement "безопасно" увеличивают/уменьшают на единицу глобальный счётчик количества запросов на создание объекта. Впишем их прототипы в структуру MAP:


    MODULE('WIN API')
      InterlockedIncrement(*LONG Var),LONG,PASCAL,PROC
      InterlockedDecrement(*LONG Var),LONG,PASCAL,PROC
    END

Реализуем методы интерфейса IUnknown:


Math.IMath.QueryInterface PROCEDURE(LONG riid,*LONG ppvObject)
  CODE
  RETURN SELF.QueryInterface(riid,ppvObject)

Math.QueryInterface PROCEDURE(LONG riid,*LONG ppvObject)
  CODE
  ppvObject=0
  IF IsEqualIID(riid,ADDRESS(_IUnknown)) |
  OR IsEqualIID(riid,ADDRESS(IID_IMath))
    ppvObject=ADDRESS(SELF.IMath)
    IF ppvObject=0
      RETURN E_NOINTERFACE
    END
    SELF.AddRef()
    RETURN COM_NOERROR
  ELSE
    RETURN E_NOINTERFACE
  END

Math.IMath.AddRef PROCEDURE()
  CODE
  RETURN SELF.AddRef()

Math.AddRef PROCEDURE()
  CODE
  RETURN InterlockedIncrement(SELF.m_lRef)

Math.IMath.Release  PROCEDURE()
  CODE
  RETURN SELF.Release()

Math.Release  PROCEDURE()
  CODE
  InterlockedDecrement(SELF.m_lRef)
  IF SELF.m_lRef=0
    DISPOSE(SELF)
    RETURN 0
  END
  RETURN SELF.m_lRef

В методе QueryInterface мы проверяем запрашиваемый интерфейс на правильность, т.е. чтобы он был или наш IMath, или, в крайнем случае, родительский IUnknown (про другие интерфейсы мы и не знаем). Для сравнения воспользуемся функцией IsEqualIID из файла svcom.clw - целиком скопируем её оттуда:


IsEqualIID  PROCEDURE(LONG riid1,LONG riid2)
Guid1       LIKE(_GUIDL)
Guid2       LIKE(_GUIDL)
  CODE
    memcpy(address(Guid1), riid1, size(_GUID))
    memcpy(address(Guid2), riid2, size(_GUID))
    if (Guid1.Data1 = Guid2.Data1)
      if (Guid1.Data2 = Guid2.Data2)
        if (Guid1.Data3 = Guid2.Data3)
          if (Guid1.Data4 = Guid2.Data4)
            return true
          end
        end
      end
    end
    return false

Опишем её, а также API-функцию memcpy в нашей MAP:


    MODULE('cw runtime')
      memcpy(LONG lpDest,LONG lpSource,LONG nCount),LONG,PROC,NAME('_memcpy')
    END

    IsEqualIID(LONG riid1,LONG riid2),BYTE

Метод AddRef увеличивает счётчик ссылок на интерфейс, метод Release уменьшает, и при равенстве его нулю выгружает из памяти.

Теперь приступим к реализации собственно методов IMath:


Math.IMath._Add PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  RETURN SELF._Add(Op1,Op2,pResult)

Math._Add PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  pResult=Op1+Op2
  RETURN S_OK

Math.IMath.Subtract PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  RETURN SELF.Subtract(Op1,Op2,pResult)

Math.Subtract PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  pResult=Op1-Op2
  RETURN S_OK

Math.IMath.Multiply PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  RETURN SELF.Multiply(Op1,Op2,pResult)

Math.Multiply PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  pResult=Op1*Op2
  RETURN S_OK

Math.IMath.Divide PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  RETURN SELF.Divide(Op1,Op2,pResult)

Math.Divide   PROCEDURE(LONG Op1,LONG Op2,*LONG pResult)
  CODE
  IF Op2 = 0
    pResult=0
  ELSE
    pResult=Op1/Op2
  END
  RETURN S_OK

Тут, на мой взгляд, всё ясно. Единственно, можно вернуть что-нибудь типа E_EXCEPTION из метода Divide при попытке деления на 0.

Вы спросите: "А зачем дублировать методы интерфейса методами класса, не проще весь функционал реализовать в методах Math.IMath.xxx, а методы класса вообще выкинуть?" На это могу сказать одно: внутреннее чутьё мне подсказывает, что так делать не надо.

Интерфейс IMath мы реализовали. Что дальше? Дальше нам нужно реализовать интерфейс IClassFactory. В MSDN написано: You must implement this interface for every class that you register in the system registry and to which you assign a CLSID, so objects of that class can be created.

Вобщем, этот интерфейс нужен нам, чтобы система смогла работать с IMath стандартным образом.

Почему-то IClassFactory забыли включить в файл svcomdef.inc, ну опишем его сами:


IClassFactory INTERFACE(IUnknown),COM,TYPE
CreateInstance  PROCEDURE(LONG pUnkOuter,LONG riid,*LONG ppvObject),LONG
LockServer      PROCEDURE(BOOL fLock),LONG
              END

и класс, реализующий его:


MathCF        CLASS,IMPLEMENTS(IClassFactory),TYPE
m_lRef          LONG,PROTECTED

Construct       PROCEDURE()
Destruct        PROCEDURE()

QueryInterface  PROCEDURE(LONG riid,*LONG ppvObject),LONG
AddRef          PROCEDURE,LONG,PROC
Release         PROCEDURE,LONG,PROC

CreateInstance  PROCEDURE(LONG pUnkOuter,LONG riid,*LONG ppvObject),LONG
LockServer      PROCEDURE(BOOL fLock),LONG
              END

MathCF.Construct  PROCEDURE()
  CODE
  SELF.m_lRef=0

MathCF.Destruct   PROCEDURE()
  CODE

MathCF.IClassFactory.QueryInterface  PROCEDURE(LONG riid,*LONG ppvObject)
  CODE
  RETURN SELF.QueryInterface(riid,ppvObject)

MathCF.QueryInterface  PROCEDURE(LONG riid,*LONG ppvObject)
  CODE
  ppvObject=0
  IF IsEqualIID(riid,ADDRESS(_IUnknown)) |
  OR IsEqualIID(riid,ADDRESS(_IClassFactory))
    ppvObject=ADDRESS(SELF.IClassFactory)
    IF ppvObject=0
      RETURN E_NOINTERFACE
    END
    SELF.AddRef()
    RETURN COM_NOERROR
  ELSE
    RETURN E_NOINTERFACE
  END

MathCF.IClassFactory.AddRef PROCEDURE()
  CODE
  RETURN SELF.AddRef()

MathCF.AddRef PROCEDURE()
  CODE
  RETURN InterlockedIncrement(SELF.m_lRef)

MathCF.IClassFactory.Release  PROCEDURE()
  CODE
  RETURN SELF.Release()

MathCF.Release  PROCEDURE()
  CODE
  InterlockedDecrement(SELF.m_lRef)
  IF SELF.m_lRef=0
    DISPOSE(SELF)
    RETURN 0
  END
  RETURN SELF.m_lRef

MathCF.IClassFactory.CreateInstance  PROCEDURE(LONG pUnkOuter,LONG riid,*LONG ppvObject)
  CODE
  RETURN SELF.CreateInstance(pUnkOuter,riid,ppvObject)

MathCF.CreateInstance  PROCEDURE(LONG pUnkOuter,LONG riid,*LONG ppvObject)
pMath       &Math
hr          LONG
  CODE
  ppvObject=0

  pMath &= NEW(Math)
  IF (pMath &= NULL)
    RETURN E_OUTOFMEMORY
  END

  hr = pMath.QueryInterface(riid,ppvObject)
  IF hr <> S_OK
    DISPOSE(pMath)
  END

  RETURN hr

MathCF.IClassFactory.LockServer      PROCEDURE(BOOL fLock)
  CODE
  RETURN SELF.LockServer(fLock)

MathCF.LockServer      PROCEDURE(BOOL fLock)
  CODE
  IF fLock
    InterlockedIncrement(g_lLocks)
  ELSE
    InterlockedDecrement(g_lLocks)
  END

  RETURN S_OK

В методе CreateInstance мы создаём наш объект Math и возвращаем указатель на интерфейс IMath. Если, конечно, именно он и запрашивается.

Собственно, всё готово, осталось только написать 4 функции, которые будут нашей библиотекой экспортироваться во внешний мир:


    DllGetClassObject(LONG rclsid,LONG riid,*LONG ppv),LONG,PASCAL
    DllCanUnloadNow(),LONG,PASCAL
    DllRegisterServer(),LONG,PASCAL
    DllUnregisterServer(),LONG,PASCAL

Первая возвращает указатель на интерфейс IMath, вторая выставляет флаг "библиотека более никому не нужна, можно выгружать!" (за саму выгрузку отвечает COM-система Windows), две последние регистрируют dll в системном реестре и удаляют из него (regsvr32.exe).


DllGetClassObject   PROCEDURE(LONG rclsid,LONG riid,*LONG ppv)
hr                  LONG
pCF                 &MathCF
  CODE
  IF ~IsEqualIID(rclsid,ADDRESS(CLSID_Math))
    RETURN E_FAIL
  END

  pCF &= NEW(MathCF)
  IF (pCF &= NULL)
    RETURN E_OUTOFMEMORY
  END

  hr = pCF.QueryInterface(riid,ppv)
  IF hr <> S_OK
    DISPOSE(pCF)
    pCF &= NULL
  END

  RETURN hr

DllCanUnloadNow     PROCEDURE()
  CODE
  IF g_lObjs OR g_lLocks
    RETURN S_FALSE
  ELSE
    RETURN S_OK
  END

DllRegisterServer   PROCEDURE()
FileName            CSTRING(256)
hInstDll            LONG

w                   WINDOW    !to get proper hModule
                    END
  CODE
  OPEN(w)
  w{prop:hide}=true
  ACCEPT
    hInstDll=SYSTEM{prop:ImageInstance}
    BREAK
  END
  CLOSE(w)

  GetModuleFileName(hInstDll,ADDRESS(FileName),255)

  IF PUTREG(REG_CLASSES_ROOT,CLSID_Math_Key&'\InprocServer32','',FileName,REG_SZ) <> 0
    RETURN SELFREG_E_CLASS
  END
  IF PUTREG(REG_CLASSES_ROOT,CLSID_Math_Key,'','Math object',REG_SZ) <> 0
    RETURN SELFREG_E_CLASS
  END

  RETURN S_OK

DllUnregisterServer PROCEDURE()
  CODE
  DELETEREG(REG_CLASSES_ROOT,CLSID_Math_Key)
  RETURN S_OK

В DllGetClassObject нам понадобился глобальный идентификатор на объект Math, реализующий интерфейс IMath. Сгенерим его в той же guidgen.exe:


CLSID_Math    GROUP
Data1           LONG(0738A6F8FH)
Data2           SHORT(0DED9H)
Data3           SHORT(0463CH)
Data4           STRING('<0B9h><0DEh><0E4h><018h><0BDh><07Dh><04Dh><05Dh>')
              END

Для записи в реестр заведём строковую константу, определяющую наш GUID:


CLSID_Math_Key  STRING('CLSID\\{{738A6F8F-DED9-463c-B9DE-E418BD7D4D5D}')

API-функция GetModuleFileName возвращает нам полный путь к нашей dll, который мы записываем в реестр, чтобы все знали, где нас искать. Способ получения хэндла dll любезно подсказан Олегом Фоминым, за что ему ещё раз большое спасибо: открываем окно, читаем SYSTEM{prop:ImageInstance} и закрываем окно, а полученное значение передаём в GetModuleFileName.

GetModuleFileName внесём в MAP, а также объявим константы для возврата при ошибке записи в реестр:


    MODULE('WIN API')
      !*** это у нас уже есть
      InterlockedIncrement(*LONG Var),LONG,PASCAL,PROC
      InterlockedDecrement(*LONG Var),LONG,PASCAL,PROC
      !***

      GetModuleFileName(LONG,LONG,ULONG),ULONG,PASCAL,PROC,NAME('GetModuleFileNameA')
    END

  INCLUDE('equates.clw')

SELFREG_E_FIRST             EQUATE(80040200H)
SELFREG_E_LAST              EQUATE(8004020FH)
SELFREG_E_TYPELIB           EQUATE(SELFREG_E_FIRST+0)
SELFREG_E_CLASS             EQUATE(SELFREG_E_FIRST+1)

Осталось, кажется, единственное, а именно, exp-файл, в котором описаны наши экспортируемые функции, math.exp:


LIBRARY math
EXPORTS

  DllGetClassObject   @?
  DllCanUnloadNow     @?
  DllRegisterServer   @?
  DllUnregisterServer @?

Всё. Компилируем проект, получаем math.dll. Регистрируем в системе "regsvr32.exe math.dll". Можно убедиться, что и в реестре наша библиотека появилась (например, задать поиск по строке "738A6F8F-DED9-463c-B9DE-E418BD7D4D5D"), и oleview.exe видит наш COM-объект (например, "All objects->Math object").

Осталось написать тест работы с созданным нами интерфейсом.

Начнём новый проект client.pr. Сразу в defines (свойства проекта) запишем


_SVDllMode_=>0
_SVLinkMode_=>1

чтобы svcom-классы (которые мы подключим) работали.

Начнём писать client.clw:


  PROGRAM

  INCLUDE('svcomdef.inc'),ONCE
  MAP
    INCLUDE('svapifnc.inc')
  END
  INCLUDE('svcom.inc')

В svapifnc.inc определена нужная нам функция CoCreateInstance, создающая экземпляр COM-объекта. В svcom.inc есть класс CCOMIniter, который позволяет обойтись без явного вызова функций инициализации/деинициализации глобальной COM-библиотеки. Достаточно просто объявить переменную типа CCOMIniter.


locCOMIniter          CCOMIniter

loc:dwClsContext - константа для передачи в CoCreateInstance (не заморачивайтесь её значением), loc:lpInterface - адрес интерфейса IMath, который мы надеемся получить, HR - код возврата CoCreateInstance, CLSID_Math и IID_IMath - соответственно GUID объекта и интерфейса.


loc:dwClsContext      ULONG(17H)
loc:lpInterface       LONG
HR                    HRESULT

CLSID_Math    GROUP
Data1           LONG(0738A6F8FH)
Data2           SHORT(0DED9H)
Data3           SHORT(0463CH)
Data4           STRING('<0B9h><0DEh><0E4h><018h><0BDh><07Dh><04Dh><05Dh>')
              END

IID_IMath     GROUP
Data1           LONG(0FD594C17H)
Data2           SHORT(0CE75H)
Data3           SHORT(04075H)
Data4           STRING('<092h><08Fh><0E4h><0D7h><0C2h><054h><0DAh><06h>')
              END

Ну и опишем сам интерфейс (добавим к методам атрибут PROC, чтобы не проверять возврат):


IMath         INTERFACE(IUnknown),COM,TYPE
_Add            PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG,PROC
Subtract        PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG,PROC
Multiply        PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG,PROC
Divide          PROCEDURE(LONG Op1,LONG Op2,*LONG pResult),LONG,PROC
              END

Math1         &IMath

А это наши операнды и результат:


Op1           LONG(27)
Op2           LONG(3)
Res           LONG

Теперь исполняемый код:


  CODE
  HR=CoCreateInstance(ADDRESS(CLSID_Math),0,loc:dwClsContext,ADDRESS(IID_IMath),loc:lpInterface)
  IF HR=S_OK
    Math1 &= (loc:lpInterface)
    Math1._Add(Op1,Op2,Res)
    stop(Op1&'+'&Op2&'='&Res)
    Math1.Subtract(Op1,Op2,Res)
    stop(Op1&'-'&Op2&'='&Res)
    Math1.Multiply(Op1,Op2,Res)
    stop(Op1&'*'&Op2&'='&Res)
    Math1.Divide(Op1,Op2,Res)
    stop(Op1&'/'&Op2&'='&Res)
  END

CoCreateInstance при успехе (S_OK) в переменной loc:lpInterface возвращает адрес запрошенного интерфейса IID_IMath, что позволяет использовать его методы.

Скачать пример

комментариев

COM сервер, IIS и BSTRING
Written by vadimberman on 2007-06-12 22:43:39

Уважаемый Дед Пахом!

У меня к Вам вопрос. Я наваял по Вашим шаблонам классы, добавив IDispatch для скриптов. В общем всё работает. Кроме уродского IIS-а, который почему-то виснет, когда методы, возвращающие или даже читающие данные типа BSTRING, вызываются второй раз.

Можете попробовать со своим математическим классом. Добавьте простейший метод, который возвращает простой BSTRING, типа 'Hello world'.

Похоже на какой-то memory leak, т.к. если вызвать метод Session.Abandon, который возвращает сессию к начальному состоянию, сервер не виснет. Но это, конечно, не выход.

Re: COM сервер, IIS и BSTRING
Written by vadimberman on 2007-07-17 19:15:07

На случай, если кому-то понадобится: забыл вызвать AttachThreadToClarion(TRUE) в начале процесса...

Only registered users can write comments.
Please login or register.

Последнее обновление ( 26.02.2006 )

< Пред.		След. >