INIT

 (Available in 01 TS COM - TS_COM_DelegateIDispatch)

Purpose

Create a 'TS_DelegateIDispatch' instance

Syntax

oDelegateIDispatch:=TS_DelegateIDispatch{ NIL, "Outlook.Application" }

Arguments

uoOwner
 NIL, OBJECT
uocpXUnknownID
 OBJECT, STRING, POINTER(GUID)
uloSelfDestruct
 NIL, LOGIC, OBJECT
ulXUnknownIDIsInterface
 NIL, LOGIC(If true then uocpXUnknownID is a interface pointer )

Description

This class is equivalent to the VO 'OLEAutoObject' class. It provodes a wrapper for the 'IDispatch' COM interface that is dynamicly allocated and will be collected by the GC when it looses scope.

The base class provides the standaard methods and properties for the COM 'IDispatch' interface, other methods, that are specific for a given interface must be added before the class can do any actual work.

The simplest way to do this is using the 'TS Automation Server' tool from the VO 'Tools'-menu. An alternative way is to use the 'TS OLEAutoConverter' progam ( also part of the COMSDK ).

The code-generators use prefixes for the method and property names to prevent name clashes, CA for ACCESS/ASSIGN, CM for methods.

Example

CLASS SomeClass INHERIT TS_DelegateIDispatch

METHOD INIT( uoOwner, uocpXUnknownID, uloSelfDestruct, ulXUnknownIDIsInterface )  ; ...
...CLASS SomeClass
   IF LOGIC( _CAST, _AND( SELF:_ObjectStat1, TS_OBJSTAT1_ININIT  ; ...
  ... ) )
      SELF:_ObjectStat1+=TS_OBJSTAT1_COUNTVALUE
      IF IsNil( uocpXUnknownID )
         uocpXUnknownID:="Outlook.Application"
      END
      SUPER:INIT( uoOwner, uocpXUnknownID, uloSelfDestruct ; ...
     ... , ulXUnknownIDIsInterface )
      SELF:_ObjectStat1-=TS_OBJSTAT1_COUNTVALUE
      IF _AND( SELF:_ObjectStat1, TS_OBJSTAT1_NEWTEST )==TS_OBJSTAT1_NEEDNEW
         SELF:_ObjectStat1:=_AND( SELF:_ObjectStat1 ; ...
        ... , _NOT( TS_OBJSTAT1_NEEDNEW ) )
         IF SELF:IsValidObject
            SELF:NEW( uoOwner, uocpXUnknownID, uloSelfDestruct ; ...
           ... , ulXUnknownIDIsInterface )
         ELSE
            TSTrace Warning TS_TEXT_GEN_CAN_NOT_INITIALIZE
            SELF:InvalidateObject( )
         END
      END
   ELSE
      TSTrace Warning TS_TEXT_GEN_ALREADY_INITIALIZED
   END
RETURN SELF

CLASS MyOutlookApplication INHERIT DelegateIDispatch

METHOD Inil( uoOwner ) CLASS MyOutlookApplication
   SUPER:INIT( uoOwner, "Outlook.Application", NIL  ; ...
  ... )
RETURN SELF

ACCESS CAFeatureInstall CLASS MyOutlookApplication
RETURN SELF:IVarGet( #FeatureInstall )

ASSIGN CAFeatureInstall( uParam001 ) CLASS MyOutlookApplication
RETURN SELF:IVarPut( #FeatureInstall, uParam001 )

METHOD CMCreateItem( ItemType ) CLASS MyOutlookApplication
RETURN SELF:Send( #CreateItem, ItemType )

Source

METHOD INIT( uoOwner, uocpXUnknownID, uloSelfDestruct, ulXUnknownIDIsInterface )  ; ...
...CLASS TS_DelegateIDispatch
   TSTrace Enter CREATE
   IF LOGIC( _CAST, _AND( SELF:_ObjectStat1, TS_OBJSTAT1_ININIT  ; ...
  ... ) )
      SELF:_ObjectStat1+=TS_OBJSTAT1_COUNTVALUE
      SUPER:INIT( uoOwner, uocpXUnknownID, uloSelfDestruct ; ...
     ... , ulXUnknownIDIsInterface )
      IF SELF:IsInvalidated
         SELF:_ObjectStat1-=TS_OBJSTAT1_COUNTVALUE
         TSTrace Warning "SELF:IsInvalidated"
         SELF:InvalidateObject( )
      ELSE
         SELF:_MethodIDCashItems:=MemAlloc( _SIZEOF( TS_MethodIDCashItem  ; ...
        ... )*TS_METHOD_ID_CASH_MAX )
         IF SELF:_MethodIDCashItems==NULL_PTR
            SELF:_ObjectStat1-=TS_OBJSTAT1_COUNTVALUE
            TSTrace Fatal "SELF:_MethodIDCashItems:=MemAlloc(_SizeOf(TS_MethodIDCashItem)*TS_METHOD_ID_CASH_MAX)==NULL_PTR"
         ELSE
            SELF:_MethodIDCashMax:=TS_METHOD_ID_CASH_MAX
            SELF:_ObjectStat1-=TS_OBJSTAT1_COUNTVALUE
            IF _AND( SELF:_ObjectStat1, TS_OBJSTAT1_NEWTEST ) ; ...
           ... ==TS_OBJSTAT1_NEEDNEW
               SELF:_ObjectStat1:=_AND( SELF:_ObjectStat1 ; ...
              ... , _NOT( TS_OBJSTAT1_NEEDNEW ) )
               IF SELF:IsValidObject
                  SELF:NEW( uoOwner, uocpXUnknownID ; ...
                 ... , uloSelfDestruct, ulXUnknownIDIsInterface )
               ELSE
                  TSTrace Warning TS_TEXT_GEN_CAN_NOT_INITIALIZE
                  SELF:InvalidateObject( )
               END
            END
         END
      END
   ELSE
      TSTrace Warning "!LOGIC(_CAST,_And(SELF:_ObjectStat1,TS_OBJECT_STATUS_ININIT))"
   END
   TSTrace Leave
RETURN SELF