INIT

 (Available in 01 TS COM - TS_COM_DelegateIUnknown)

Purpose

Create a 'TS_DelegateIUnknown' instance

Syntax

oDelegateIUnknown:=TS_DelegateIUnknown{ 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 serves no purpose on its own, the class should be used as a derived from class when defining you own application classes.

Note: If the 'uloSelfDestruct' parameter is TRUE and no owner for the class is provided a error will be signaled and the object is invalidated.

Note: Passing an object as the'uloSelfDestruct' parameter is only allowed if this class is an instance of 'TS_Root2' otherwise an error will be signaled, and the object is invalidated.

Example

CLASS SomeClass INHERIT TS_DelegateIUnknown

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

Source

METHOD INIT( uoOwner, uocpXUnknownID, uloSelfDestruct, ulXUnknownIDIsInterface )  ; ...
...CLASS TS_DelegateIUnknown
LOCAL oServerInfoGuard AS TS_ServerInfoGuard
LOCAL cAccessTypeList AS STRING
LOCAL oServerInfo AS TS_ServerInfo
LOCAL cXUnknownID AS STRING
LOCAL oXUnknownID AS OBJECT
LOCAL pXUnknownID AS PTR
LOCAL pWordString AS PTR
LOCAL oAIUnknown AS TS_AbstractIUnknown
LOCAL struCLSID IS _WinGUID
LOCAL hResult AS LONG
LOCAL lInit AS LOGIC
   TSTrace Enter CREATE
   IF LOGIC( _CAST, _AND( SELF:_ObjectStat1, TS_OBJSTAT1_ININIT  ; ...
  ... ) )
      SELF:_ObjectStat1+=TS_OBJSTAT1_COUNTVALUE
      cAccessTypeList:=TS_AccessTypeList( uoOwner, uocpXUnknownID, uloSelfDestruct ; ...
     ... , ulXUnknownIDIsInterface )
      lInit:=TRUE
      DO CASE
      CASE CharPos( cAccessTypeList, 1 )=="U"
//       Do nothing
      CASE CharPos( cAccessTypeList, 1 )=="O"
//       Do nothing
      OTHERWISE
         lInit:=FALSE
      END
      DO CASE
      CASE CharPos( cAccessTypeList, 2 )=="O"
//       Do nothing
      CASE CharPos( cAccessTypeList, 2 )=="C"
//       Do nothing
      CASE CharPos( cAccessTypeList, 2 )=="-"
//       Do nothing
      CASE CharPos( cAccessTypeList, 2 )=="*"
//       Do nothing
      OTHERWISE
         lInit:=FALSE
      END
      DO CASE
      CASE CharPos( cAccessTypeList, 3 )=="U"
//       Do nothing
      CASE CharPos( cAccessTypeList, 3 )=="L"
//       Do nothing
      CASE CharPos( cAccessTypeList, 3 )=="O"
//       Do nothing
      OTHERWISE
         lInit:=FALSE
      END
      DO CASE
      CASE CharPos( cAccessTypeList, 4 )=="U"
//       Do nothing
      CASE CharPos( cAccessTypeList, 4 )=="L"
//       Do nothing
      OTHERWISE
         lInit:=FALSE
      END
      IF lInit
         SUPER:INIT( uoOwner, NIL, uloSelfDestruct  ; ...
        ... )
         IF SELF:_OLE32LibraryInited==0U
            oServerInfoGuard:=TS_ServerInfoGuard{ }
            oServerInfo:=oServerInfoGuard:Get( COINIT_DEFAULT, NULL_PTR  ; ...
           ... )
            IF SELF:IsInvalidated
               SELF:_OLE32LibraryInited:=2U
            ELSE
               IF SELF:_CoInitMode==COINIT_NONE
                  SELF:_CoInitMode:=oServerInfo:CoInit
               END
               hResult:=S_OK
               IF oServerInfo:OLE32LibraryLoad( SELF:_CoInitMode ; ...
              ... , @hResult )
                  SELF:_OLE32LibraryInited:=1U
               ELSE
                  SELF:_OLE32LibraryInited:=2U
                  TSTrace Warning "!oServerInfo:OLE32LibraryLoad(SELF:_CoInitMode" ; ...
                 ... +",@hResult)"
                  SELF:InvalidateObject( )
               END
            END
            oServerInfo:=oServerInfoGuard:FREEREF( )
            oServerInfoGuard:=NULL_OBJECT
         END
         DO CASE
         CASE SELF:IsInvalidated
            TSTrace Warning "SELF:IsInvalidated"
            SELF:InvalidateObject( )
         CASE IsObject( uocpXUnknownID )
            hResult:=S_OK
            oAIUnknown:=NULL_OBJECT
            oXUnknownID:=uocpXUnknownID
            DO CASE
            CASE oXUnknownID==NULL_OBJECT
               TSTrace Warning "oXUnknownID==NULL_OBJECT"
               SELF:InvalidateObject( )
            CASE IsLogic( ulXUnknownIDIsInterface ) .AND. ulXUnknownIDIsInterface
               oAIUnknown:=oXUnknownID
               IF !SELF:_CreateInstanceFromAIUnknown( oAIUnknown  ; ...
              ... )
                  TSTrace Warning "!SELF:_CreateInstanceFromAIUnknown(oAIUnknown)"
                  SELF:InvalidateObject( )
                  oAIUnknown:Release( )
                  oAIUnknown:=NULL_OBJECT
               END
            CASE _TS_Object2AIUnknownPointer( oXUnknownID, SELF:IID ; ...
           ... , @oAIUnknown, @hResult )
               IF oAIUnknown<>NULL_OBJECT
                  IF !SELF:_CreateInstanceFromAIUnknown( oAIUnknown  ; ...
                 ... )
                     TSTrace Warning "!SELF:_CreateInstanceFromAIUnknown(oAIUnknown)"
                     SELF:InvalidateObject( )
                     oAIUnknown:Release( )
                     oAIUnknown:=NULL_OBJECT
                  END
               ELSE
                  TSTrace Warning "oAIUnknown==NULL_OBJECT"
                  SELF:InvalidateObject( )
               END
            OTHERWISE
               TSTrace Warning "!_TS_Object2AIUnknownPointer(oXUnknownID,SELF:IID" ; ...
              ... +",@oAIUnknown,@hResult)"
               SELF:InvalidateObject( )
            END
         CASE IsString( uocpXUnknownID )
            cXUnknownID:=uocpXUnknownID
            IF Empty( cXUnknownID )
               TSTrace Warning "Empty(cXUnknownID)"
               SELF:InvalidateObject( )
            ELSE
               pWordString:=TS_String2UniCodeBSTR( cXUnknownID )
               IF pWordString<>NULL_PTR
                  DO CASE
                  CASE TS_HSucceeded( _TS_CLSIDFromProgID( pWordString, @struCLSID  ; ...
                 ... ), FALSE )
                     IF !SELF:_CreateInstanceFromCLSID( @struCLSID  ; ...
                    ... )
                        TSTrace Warning "!SELF:_CreateInstanceFromCLSID(@struCLSID)"  ; ...
                       ... cXUnknownID
                        SELF:InvalidateObject( )
                     END
                  CASE TS_HSucceeded( _TS_CLSIDFromString( pWordString, @struCLSID  ; ...
                 ... ), FALSE )
                     IF !SELF:_CreateInstanceFromCLSID( @struCLSID  ; ...
                    ... )
                        TSTrace Warning "!SELF:_CreateInstanceFromCLSID(@struCLSID)"  ; ...
                       ... cXUnknownID
                        SELF:InvalidateObject( )
                     END
                  OTHERWISE
                     TSTrace Warning "!(TS_CLSIDFromString(cXUnknownID,@struCLSID" ; ...
                    ... +",FALSE) .AND. TS_CLSIDFromProgID(cXUnknownID,@struCLSID" ; ...
                    ... +",FALSE))" cXUnknownID
                     SELF:InvalidateObject( )
                  END
                  SysFreeString( pWordString )
               ELSE
                  TSTrace Warning "(pWordString:=TS_String2UniCodeBSTR(cXUnknownID))==NULL_PTR"  ; ...
                 ... cXUnknownID
                  SELF:InvalidateObject( )
               END
            END
         CASE IsPtr( uocpXUnknownID )
            pXUnknownID:=uocpXUnknownID
            DO CASE
            CASE pXUnknownID==NULL_PTR
               TSTrace Warning "pXUnknownID==NULL_PTR"
               SELF:InvalidateObject( )
            CASE IsLogic( ulXUnknownIDIsInterface ) .AND. ulXUnknownIDIsInterface
               oAIUnknown:=OBJECT( _CAST, pXUnknownID )
               IF !SELF:_CreateInstanceFromAIUnknown( oAIUnknown  ; ...
              ... )
                  TSTrace Warning "!SELF:_CreateInstanceFromAIUnknown(oAIUnknown)"
                  SELF:InvalidateObject( )
                  oAIUnknown:Release( )
                  oAIUnknown:=NULL_OBJECT
               END
            OTHERWISE
               IF !SELF:_CreateInstanceFromCLSID( pXUnknownID  ; ...
              ... )
                  TSTrace Warning "!SELF:_CreateInstanceFromCLSID(pXUnknownID)" pXUnknownID
                  SELF:InvalidateObject( )
               END
            END
         OTHERWISE
            TSTrace Warning "Unhandled source 'uocpXUnknownID' for interface"
            SELF:InvalidateObject( )
         END
         IF SELF:_AIUnknown==NULL_OBJECT
            TSTrace Warning "SELF:_AIUnknown==NULL_OBJECT"
            SELF:InvalidateObject( )
         ELSE
            SELF:RegisterAxit( )
         END
      ELSE
         TSTrace Warning "Invalid parameter(s), Expected 'U|O', 'O|C|-|*' and 'U|L|O'" ; ...
        ... +", Found '"+cAccessTypeList+"'"
         SELF:InvalidateObject( )
      END
      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 "!LOGIC(_CAST,_And(SELF:_ObjectStat1,TS_OBJECT_STATUS_ININIT))"
   END
   TSTrace Leave
RETURN SELF