CreateInstance

 (Available in 01 TS COM - TS_COM_IClassFactory)

Source

METHOD CreateInstance( poOuterAIUnknown AS TS_AbstractIUnknown PTR, pStruIID AS _WinGUID ; ...
..., poResultAIInterface AS TS_AbstractIUnknown PTR ) AS LONG PASCAL CLASS TS_IClassFactory
LOCAL poAICreatedInterface AS TS_AbstractIUnknown PTR
LOCAL oAICreatedInterface AS TS_AbstractIUnknown
LOCAL oCOMGlobalData AS _TS_COMGlobalData
LOCAL oManufacture AS TS_DelegateIDispatch
LOCAL oIUnknown AS TS_IUnknown
LOCAL hResult AS LONG
   TSTrace Enter
   oCOMGlobalData:=_TS_ModuleGetCOMGlobalData( )
   #IFDEF TS_COMGLOBALDATA_CRITICALSECTION
      EnterCriticalSection( oCOMGlobalData:_COMGGeneralPurposeSection )
   #ENDIF
   hResult:=S_OK
// TSTrace ToDo "If 'poAICreatedInterface:=poResultAIInterface' is o.k. then the  ; ...
// ...var 'poAICreatedInterface' can be removed"
   poAICreatedInterface:=poResultAIInterface
   DO CASE
   CASE !SELF:IsValidObject
      TSTrace Warning "!SELF:IsValidObject"
      IF poResultAIInterface<>NULL_PTR
         OBJECT( PTR( _CAST, poResultAIInterface ) ):=NULL_OBJECT
      ELSE
         TSTrace Warning "poResultAIInterface==NULL_PTR"
      END
      hResult:=CLASS_E_CLASSNOTAVAILABLE
   CASE poResultAIInterface==NULL_PTR
      TSTrace Warning "poResultAIInterface==NULL_PTR"
      hResult:=CLASS_E_CLASSNOTAVAILABLE
   CASE pStruIID==NULL_PTR
      TSTrace Warning "pStruIID==NULL_PTR"
      OBJECT( PTR( _CAST, poResultAIInterface ) ):=NULL_OBJECT
      hResult:=CLASS_E_CLASSNOTAVAILABLE
   CASE !Empty( SELF:_ManufactureStr )
      oManufacture:=TS_DelegateIDispatch{ NULL_OBJECT, SELF:_ManufactureStr ; ...
     ... , NIL }
      IF oManufacture:IsValidObject
         hResult:=oManufacture:CMQueryInterface( pStruIID, poAICreatedInterface  ; ...
        ... )
         IF TS_HFailed( hResult, TRUE )
            TSTrace Warning "TS_HFailed(oManufacture:CMQueryInterface(pStruIID,poAICreatedInterface))"
            OBJECT( PTR( _CAST, poAICreatedInterface ) ):=NULL_OBJECT
         ELSE
            PTR( @oAICreatedInterface ):=poAICreatedInterface
         END
      ELSE
         TSTrace Warning "!oManufacture:IsValidObject" oManufacture _ManufactureStr
      END
      oManufacture:Destroy( )
      oManufacture:=NULL_OBJECT
   CASE IsClass( SELF:_ManufactureSym )
      hResult:=TS_CreateInstanceIUnknown( SELF:_ManufactureSym
//    Class
      , NULL_OBJECT
//    Owner
      , NULL_SYMBOL
//    SymName
      , poOuterAIUnknown
//    OuterAIUnknown
//    ResultPointer
      , @oIUnknown ) 
      IF TS_HSucceeded( hResult, TRUE )
         hResult:=oIUnknown:QueryInterface( pStruIID, poAICreatedInterface  ; ...
        ... )
         DO CASE
         CASE hResult==E_NOINTERFACE
            IF TS_ShowNotSupportedInterfaces( )
               TS_DebOutSTRING( "Interface '"+TS_GUID2String( pStruIID )+"' not supported"  ; ...
              ... )
            END
            OBJECT( PTR( _CAST, poAICreatedInterface ) ):=NULL_OBJECT
         CASE TS_HFailed( hResult, TRUE )
            TSTrace Warning "oIUnknown:QueryInterface(pStruIID,poAICreatedInterface)"
            OBJECT( PTR( _CAST, poAICreatedInterface ) ):=NULL_OBJECT
         OTHERWISE
            TSTrace ToDo "Check if 'Convert' is needed/used/wanted, Change fn name " ; ...
           ... +"to '_TS_RegisterAIU()'"
         END
      ELSE
         TSTrace Warning "!TS_CreateInstanceIUnknown(SELF:_ManufactureSym,NULL_OBJECT" ; ...
        ... +",NULL_SYMBOL,oConvertedOuterAIUnknown,@oIUnknown)"
         oIUnknown:=NULL_OBJECT
         hResult:=CLASS_E_CLASSNOTAVAILABLE
      END
      IF TS_HSucceeded( hResult, TRUE )
         TSTrace ToDo "Check this : 'PTR(@oAICreatedInterface):=poAICreatedInterface'"
         PTR( @oAICreatedInterface ):=poAICreatedInterface
//       oServerInfo:=TS_ServerInfoObject(#Get)
//       oAITypeLib:=oServerInfo:_AITypeLib(FALSE,NULL_OBJECT)
//       oServerInfo:=TS_ServerInfoObject(#Free)
//       IF oAITypeLib<>NULL_OBJECT
         IF SELF:_CLSID==NULL_PTR
            TSTrace ToDo NB "GetTypeInfoOfGUID(IID:="+TS_GUID2String( pStruIID )+ ; ...
           ... ", CLSID:="+TS_GUID2String( SELF:_CLSID )+")"
//          ===================================================================================================== ; ...
//          If no IID is set, then the classfactory is probably part of a 'in-proc' ; ...
//         ... server. Due to the fact
//          that the classfactory is instantiated by COM and not pre-instantiated ; ...
//         ... from the EXE-file ( out of
//          proc server ). There is no IID set by the programmer. Most of the time ; ...
//         ... ( tested with the 'SmartTag'
//          classes ) one could use the CLSID to get a valid 'TypeInfo'-interface ; ...
//         ... . All this needs to be verified
//          and tested before the 'broddel' can be accepted for the final version ; ...
//         ... of the library. When not
//          acceptable the switch should be left in place and a function to enable ; ...
//         ... IID<>CLSID usage must be
//          created.
//          ===================================================================================================== ; ...
//          TS_UseCLSIDForIID()
            IF TRUE 
               oIUnknown:IID:=pStruIID
//             TSTrace ToDo "Next line is a broddel"
//             #IFDEF TS_TRACETIMED_ENABLE
//             _TS_TraceTimedEnter(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPELIB,#GetTypeInfoOfGUID) ; ...
//             #ENDIF
//             hResult:=oAITypeLib:GetTypeInfoOfGUID(pStruIID,@oAITypeInfo)
//             #IFDEF TS_TRACETIMED_ENABLE
//             _TS_TraceTimedLeave(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPELIB,#GetTypeInfoOfGUID) ; ...
//             #ENDIF
//             IF TS_HSucceeded(hResult,TRUE)
//             IF _____TS_ConvertAndRegisterAIU(@oAITypeInfo,@oConvertedAITypeInfo ; ...
//            ... ,FALSE,NULL_SYMBOL)
//             TSTrace ToDo "Check if 'Convert' is needed/used/wanted, Change fn  ; ...
//            ... name to '_TS_RegisterAIU()'"
//             oIUnknown:_AITypeInfo:=oConvertedAITypeInfo
//             oIUnknown:IID:=pStruIID
//             IF TS_ShowNotFoundTypeInfos()
//             TSTrace Shw "Type info found for 'pStruIID'",TS_GUID2String(pStruIID) ; ...
//             END
//             ELSE
//             TSTrace Warning "!_____TS_ConvertAndRegisterAIU(@oAITypeInfo,@oConvertedAITypeInfo ; ...
//            ... ,FALSE,NULL_SYMBOL)"
//             hResult:=CLASS_E_CLASSNOTAVAILABLE
//             #IFDEF TS_TRACETIMED_ENABLE
//             _TS_TraceTimedEnter(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPEINFO,#Release) ; ...
//             #ENDIF
//             oAITypeInfo:Release()
//             #IFDEF TS_TRACETIMED_ENABLE
//             _TS_TraceTimedLeave(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPEINFO,#Release) ; ...
//             #ENDIF
//             END
//             oAITypeInfo:=NULL_OBJECT
//             ELSE
//             IF TS_ShowNotFoundTypeInfos()
//             TSTrace Shw "No type info found for 'pStruIID'",TS_GUID2String(pStruIID) ; ...
//            ... ,hResult
//             END
//             TSTrace ToDo NB "Make it so"
//             hResult:=CLASS_E_CLASSNOTAVAILABLE
//             #IFDEF TS_TRACETIMED_ENABLE
//             _TS_TraceTimedEnter(TS_TT_SYM_EXTERNAL,TS_TT_SYM_IUNKNOWN,#Release) ; ...
//             #ENDIF
//             oAICreatedInterface:Release()
//             #IFDEF TS_TRACETIMED_ENABLE
//             _TS_TraceTimedLeave(TS_TT_SYM_EXTERNAL,TS_TT_SYM_IUNKNOWN,#Release) ; ...
//             #ENDIF
//             oAICreatedInterface:=NULL_OBJECT
//             hResult:=S_OK
//             END
            ELSE
               TSTrace Warning "Read the comments in the sourcecode !!!"
               hResult:=CLASS_E_CLASSNOTAVAILABLE
               #IFDEF TS_TRACETIMED_ENABLE
                  _TS_TraceTimedEnter( TS_TT_SYM_EXTERNAL, TS_TT_SYM_IUNKNOWN, #Release  ; ...
                 ... )
               #ENDIF
               oAICreatedInterface:Release( )
               #IFDEF TS_TRACETIMED_ENABLE
                  _TS_TraceTimedLeave( TS_TT_SYM_EXTERNAL, TS_TT_SYM_IUNKNOWN, #Release  ; ...
                 ... )
               #ENDIF
               oAICreatedInterface:=NULL_OBJECT
            END
         ELSE
            TSTrace ToDo "Check this, 'oIUnknown:IID:=SELF:_CLSID' replaced by 'oIUnknown" ; ...
           ... +":IIDAdd(SELF:_CLSID)'"
//          oIUnknown:IID:=SELF:_CLSID
            oIUnknown:IIDAdd( SELF:_CLSID )
//          #IFDEF TS_TRACETIMED_ENABLE
//          _TS_TraceTimedEnter(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPELIB,#GetTypeInfoOfGUID) ; ...
//          #ENDIF
//          hResult:=oAITypeLib:GetTypeInfoOfGUID(SELF:_CLSID,@oAITypeInfo)
//          #IFDEF TS_TRACETIMED_ENABLE
//          _TS_TraceTimedLeave(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPELIB,#GetTypeInfoOfGUID) ; ...
//          #ENDIF
//          IF TS_HSucceeded(hResult,TRUE)
//          IF _____TS_ConvertAndRegisterAIU(@oAITypeInfo,@oConvertedAITypeInfo,FALSE ; ...
//         ... ,NULL_SYMBOL)
//          TSTrace ToDo "Check if 'Convert' is needed/used/wanted, Change fn name ; ...
//         ... to '_TS_RegisterAIU()'"
//          oIUnknown:_AITypeInfo:=oAITypeInfo
//          oIUnknown:IID:=SELF:_CLSID
//          IF TS_ShowNotFoundTypeInfos()
//          TSTrace Shw "Type info found for 'SELF:_CLSID'",TS_GUID2String(SELF:_CLSID) ; ...
//          END
//          ELSE
//          TSTrace Warning "!_____TS_ConvertAndRegisterAIU(@oAITypeInfo,@oConvertedAITypeInfo ; ...
//         ... ,FALSE,NULL_SYMBOL)"
//          hResult:=CLASS_E_CLASSNOTAVAILABLE
//          #IFDEF TS_TRACETIMED_ENABLE
//          _TS_TraceTimedEnter(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPEINFO,#Release)
//          #ENDIF
//          oAITypeInfo:Release()
//          #IFDEF TS_TRACETIMED_ENABLE
//          _TS_TraceTimedLeave(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPEINFO,#Release)
//          #ENDIF
//          END
//          oAITypeInfo:=NULL_OBJECT
//          ELSE
//          IF TS_ShowNotFoundTypeInfos()
//          TSTrace Shw "No type info found for 'SELF:_CLSID'",TS_GUID2String(SELF ; ...
//         ... :_CLSID),hResult
//          END
//          TSTrace ToDo "Make it so"
//          hResult:=CLASS_E_CLASSNOTAVAILABLE
//          #IFDEF TS_TRACETIMED_ENABLE
//          _TS_TraceTimedEnter(TS_TT_SYM_EXTERNAL,TS_TT_SYM_IUNKNOWN,#Release)
//          #ENDIF
//          oAICreatedInterface:Release()
//          #IFDEF TS_TRACETIMED_ENABLE
//          _TS_TraceTimedLeave(TS_TT_SYM_EXTERNAL,TS_TT_SYM_IUNKNOWN,#Release)
//          #ENDIF
//          oAICreatedInterface:=NULL_OBJECT
//          hResult:=S_OK
//          END
         END
//       #IFDEF TS_TRACETIMED_ENABLE
//       _TS_TraceTimedEnter(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPELIB,#Release)
//       #ENDIF
//       oAITypeLib:Release()
//       #IFDEF TS_TRACETIMED_ENABLE
//       _TS_TraceTimedLeave(TS_TT_SYM_EXTERNAL,TS_TT_SYM_ITYPELIB,#Release)
//       #ENDIF
//       oAITypeLib:=NULL_OBJECT
//       END
      ELSE
         TSTrace Warning "CreateInstance("+AsString( SELF:NameSym  ; ...
        ... )+"), Interface not supported, IID:="+TS_GUID2String( pStruIID )
         OBJECT( PTR( _CAST, poAICreatedInterface ) ):=NULL_OBJECT
         hResult:=CLASS_E_CLASSNOTAVAILABLE
      END
      IF oIUnknown<>NULL_OBJECT
         oIUnknown:Release( )
         oIUnknown:=NULL_OBJECT
      END
   OTHERWISE
      TSTrace Warning "CreateInstance("+AsString( SELF:NameSym  ; ...
     ... )+"), Class not found, IID:="+TS_GUID2String( pStruIID )
      OBJECT( PTR( _CAST, poAICreatedInterface ) ):=NULL_OBJECT
      hResult:=CLASS_E_CLASSNOTAVAILABLE
   END
   #IFDEF TS_COMGLOBALDATA_CRITICALSECTION
      LeaveCriticalSection( oCOMGlobalData:_COMGGeneralPurposeSection )
   #ENDIF
   TSTrace Leave
RETURN hResult