  Clarion  COM-.

  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 <<name>> =
!{ 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,
    .

 , 2005
mikeduglas@pisem.net