!
!  clsfact.f90 - This file contains methods of the IClassFactory 
!  interface that is used to create instances of the user's classes
!
!  Generated by the Intel(R) Visual Fortran COM Server Wizard on
!  12/17/20 at 11:05:56.
!
!   DO NOT EDIT THIS FILE!
!
!  This file is re-generated every time the object hierarchy is changed.
!

function IClassFactory_QueryInterface (pData, riid, ppv) result (r)
    !dec$ attributes stdcall :: IClassFactory_QueryInterface
    use IClassFactory_Types
    use ifwinty
    use ifcom
    use kernel32
    implicit none

    type (IClassFactory_Data) pData
    !dec$ attributes reference :: pData
    type(guid) riid
    !dec$ attributes reference :: riid
    integer(int_ptr_kind()) ppv
    !dec$ attributes reference :: ppv
    integer(long) r

    integer(long) i

    r = S_OK

    !  Ensure that they are requesting 
    !  the IClassFactory or IUnknown interface
    if ((.not. COMIsEqualGUID(riid, IID_IClassFactory)) .AND. &
        (.not. COMIsEqualGUID(riid, IID_IUnknown))) then
        r = E_UNEXPECTED 
        return
    end if

    i = InterlockedIncrement (loc(pData % refCount)) 
    ppv = loc(pData)

end function 

function IClassFactory_AddRef (pData) result (r)
    !dec$ attributes stdcall :: IClassFactory_AddRef
    use IClassFactory_Types
    use ifwinty
    use kernel32
    implicit none

    type (IClassFactory_Data) pData
    !dec$ attributes reference :: pData
    integer r

    integer(LONG) i

    i = InterlockedIncrement (loc(pData % refCount)) 
    r = pData % refCount

end function 

function IClassFactory_Release (pData) result (r)
    !dec$ attributes stdcall :: IClassFactory_Release
    use IClassFactory_Types
    use ifwinty
    use CropModelMKS_Optimization_SCEUA_global
    use kernel32
    implicit none

    type (IClassFactory_Data), target :: pData
    !dec$ attributes reference :: pData
    integer r

    type (IClassFactory_Data),  pointer :: pCFData
    integer status

    call EnterCriticalSection(loc(gGlobalCriticalSection))
    pData % refCount = pData % refCount - 1
    r = pData % refCount
    if (pData % refCount == 0) then
        !  Time to delete ourself....
        deallocate (pData % pVtbl)
        pCFData => pData
        deallocate (pCFData)
        !status = ServerUnlock()
    end if
    call LeaveCriticalSection(loc(gGlobalCriticalSection))

end function 

function IClassFactory_LockServer (pData, bLock) result (r)
    !dec$ attributes stdcall :: IClassFactory_LockServer
    use IClassFactory_Types
    use ifwinty
    use CropModelMKS_Optimization_SCEUA_global
    implicit none

    type (IClassFactory_Data) pData
    !dec$ attributes reference :: pData
    logical bLock
    !dec$ attributes value :: bLock
    integer(LONG) r

    integer status

    r = S_OK

    if (bLock) then
        status = ServerLock()
    else
        status = ServerUnlock()
    end if

end function 

!  Per class
function IClassFactory_CreateAnalyzerInstance (pData, pUnk, riid, ppv) result (r)
    !dec$ attributes stdcall :: IClassFactory_CreateAnalyzerInstance
    use IClassFactory_Types
    use ifwinty
    use ifcom
    use CropModelMKS_Optimization_SCEUA_global
    use Analyzer_Types
    use IAnalyzer_Methods
    implicit none

    type (IClassFactory_Data) pData
    !dec$ attributes reference :: pData
    integer(INT_PTR_KIND()) pUnk
    !dec$ attributes value :: pUnk
    type(GUID) riid
    !dec$ attributes reference :: riid
    integer(INT_PTR_KIND()) ppv
    !dec$ attributes reference :: ppv
    integer(LONG) r

    integer status
    integer(INT_PTR_KIND()) ptr
    type (Analyzer_Data),  pointer :: pAnalyzerData

    r = S_OK
    ppv = NULL

    !  Ensure that they are requesting a supported interface
    if ((.not. COMIsEqualGUID(riid, IID_IUnknown)) &
        !  Per interface
         .AND. (.not. COMIsEqualGUID(riid, IID_IAnalyzer)) &
         .AND. (.not. COMIsEqualGUID(riid, IID_IDispatch)) &
        ) then
        r = E_UNEXPECTED 
        return
    end if

    !  Class does not support aggregation
    if (pUnk /= NULL) then
        r = CLASS_E_NOAGGREGATION
        return
    endif

    !  Allocate instance data structure and Vtbl
    allocate (pAnalyzerData)

    !  Per interface
    allocate (pAnalyzerData % IAnalyzer_InternalData % pVtbl)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % QueryInterface = loc(Analyzer_QueryInterface)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % AddRef = loc(Analyzer_AddRef)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % Release = loc(Analyzer_Release)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % GetTypeInfoCount = loc(Analyzer_GetTypeInfoCount)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % GetTypeInfo = loc(Analyzer_GetTypeInfo)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % GetIDsOfNames = loc(Analyzer_GetIDsOfNames)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % Invoke = loc(Analyzer_Invoke)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % Analyze = loc($IAnalyzer_Analyze)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % Configurate = loc($IAnalyzer_Configurate)
    pAnalyzerData % IAnalyzer_InternalData % pVtbl % Description = loc($IAnalyzer_Description)
    pAnalyzerData % IAnalyzer_InternalData % pInternalData => pAnalyzerData % InternalData
    pAnalyzerData % InternalData % pStart => pAnalyzerData
    pAnalyzerData % InternalData % refCount = 1

    !  Allocate the user-defined instance data structure
    allocate (pAnalyzerData % InternalData % pInstanceData)
    !  Call the "constructor"...
    status = Analyzer_CONSTRUCTOR(pAnalyzerData % InternalData % pInstanceData)
    if (status /= S_OK) then
        deallocate (pAnalyzerData % InternalData % pInstanceData)
        deallocate (pAnalyzerData % IAnalyzer_InternalData % pVtbl)
        deallocate (pAnalyzerData)
        r = status
        return
    endif

    !  Increment the server's active object count
    status = ServerLock()

    !  Return the correct interface
    if (COMIsEqualGUID(riid, IID_IUnknown)) then
        ppv = loc(pAnalyzerData)
    !  Per interface
    else if (COMIsEqualGUID(riid, IID_IAnalyzer)) then
        ppv = loc(pAnalyzerData % IAnalyzer_InternalData)
    else if (COMIsEqualGUID(riid, IID_IDispatch)) then
        ppv = loc(pAnalyzerData % IAnalyzer_InternalData)
    end if

end function 
