ExecUntilQuit

 (Available in 01 TS COM - TS_COM_ServerInfo)

Source

METHOD ExecUntilQuit( oDispatch AS OBJECT ) AS TS_ServerInfo PASCAL CLASS TS_ServerInfo
LOCAL lUnRegisterIClassFactoryPointers AS LOGIC
LOCAL aIClassFactoryPointers AS ARRAY
LOCAL aServerInfoCoClasses AS ARRAY
LOCAL lWindow AS LOGIC
LOCAL hResult AS LONG
   TSTrace Enter
   IF SELF:IsValidObject
      InterlockedIncrement( SELF:_COMGlobalData:_ServerInfoInMessageLoop  ; ...
     ... )
      IF SELF:_COMGlobalData:_Window==NULL_PTR
         lWindow:=TRUE
         _TS_ServerInfoWindowCreate( SELF:_COMGlobalData )
      ELSE
         lWindow:=FALSE
      END
      lUnRegisterIClassFactoryPointers:=FALSE
      IF !SELF:_COMGlobalData:_ServerInfoCoClassesSet
         TSTrace ToDo "This is entry code that is not un-done or re-done on re-entry" ; ...
        ... +"!"
         SELF:_COMGlobalData:_ServerInfoCoClassesSet ; ...
        ... :=TRUE
         aServerInfoCoClasses:=SELF:_COMGlobalData:_ServerInfoCoClassesArray
         IF LOGIC( _CAST, ALen( aServerInfoCoClasses ) )
            hResult:=S_OK
            aIClassFactoryPointers:=_TS_ActivateIClassFactoryPointers( aServerInfoCoClasses ; ...
           ... , @hResult )
            IF TS_HFailed( hResult, TRUE )
               SELF:InvalidateObject( )
            ELSE
               hResult:=S_OK
               lUnRegisterIClassFactoryPointers:=TRUE
               _TS_RegisterIClassFactoryPointers( aIClassFactoryPointers, CLSCTX_LOCAL_SERVER ; ...
              ... , _OR( REGCLS_MULTIPLEUSE, REGCLS_SUSPENDED ), @hResult )
               IF TS_HFailed( hResult, TRUE )
                  SELF:InvalidateObject( )
               END
            END
         ELSE
            TSTrace Warning "!LOGIC(_CAST,ALen(aServerInfoCoClasses))"
            SELF:InvalidateObject( )
         END
         aServerInfoCoClasses:=NULL_ARRAY
      END
      IF SELF:IsValidObject
         #IFNDEF TS_CAVO2611
            SELF:_SuperGlobalData:_MaxDynSizeNew:=TS_RegServerConfigGet ; ...
           ... ( TS_RegServerConfigKey( NULL_STRING, NULL_STRING ), TS_S_MAXDYNSIZE ; ...
           ... , SetMaxDynSize( 0U ) )
            SELF:_SuperGlobalData:_MaxDynSizeNew:=Max ; ...
           ... ( SELF:_SuperGlobalData:_MaxDynSizeNew ; ...
           ... , SetMaxDynSize( 0U ) )
            SELF:_SuperGlobalData:_MaxDynSizeSet:=FALSE
            IF SELF:_SuperGlobalData:_MaxDynSizeNew ; ...
           ... >SetMaxDynSize( 0U )
               SetMaxDynSize( SELF:_SuperGlobalData:_MaxDynSizeNew  ; ...
              ... )
//             TSTrace ShwEx "After:SetMaxDynSize()",_(SELF:_SuperGlobalData:_MaxDynSizeNew) ; ...
//             ELSE
//             TSTrace ShwEx "After:RegGetServerConfig()",_(SELF:_SuperGlobalData ; ...
//            ... :_MaxDynSizeNew)
            END
//          TSTrace ShwEx DynInfoSize()
//          TSTrace ShwEx HiWord(SELF:_SuperGlobalData:_MaxDynSizeNew)
//          TSTrace ShwEx DynSize(HiWord(SELF:_SuperGlobalData:_MaxDynSizeNew)>>1U) ; ...
//          TSTrace ShwEx DynInfoSize()
            WHILE !SELF:_COMGlobalData:_ServerInfoQuit
               SELF:ExecUntilTimeOut( oDispatch, 1000U )
            END
            IF SELF:_SuperGlobalData:_MaxDynSizeSet
               SELF:_SuperGlobalData:_MaxDynSizeSet ; ...
              ... :=FALSE
               TS_RegServerConfigPut( TS_RegServerConfigKey( NULL_STRING, NULL_STRING  ; ...
              ... ), TS_S_MAXDYNSIZE, SELF:_SuperGlobalData:_MaxDynSizeNew  ; ...
              ... )
//             TSTrace ShwEx "Saved",_(SELF:_SuperGlobalData:_MaxDynSizeNew)
//             ELSE
//             TSTrace ShwEx "NotSaved",_(SELF:_SuperGlobalData:_MaxDynSizeNew)
            END
         #ENDIF
      END
      IF lUnRegisterIClassFactoryPointers
         _TS_UnRegisterIClassFactoryPointers( aIClassFactoryPointers, @hResult )
      END
      aIClassFactoryPointers:=NULL_ARRAY
      IF lWindow
         _TS_ServerInfoWindowDestroy( SELF:_COMGlobalData )
      END
      InterlockedDecrement( SELF:_COMGlobalData:_ServerInfoInMessageLoop  ; ...
     ... )
      IF LONGINT( SELF:_COMGlobalData:_ServerInfoInMessageLoop  ; ...
     ... )<0L
         TSTrace Warning "LONGINT(SELF:_COMGlobalData:_ServerInfoInMessageLoop)<0L"
      END
   ELSE
      TSTrace Warning "!SELF:IsValidObject"
   END
   TSTrace Leave
RETURN SELF