Chip: 25 Years Anniversary/CHIP_25Jahre_Jubilaeum.iso/downloads/401065/WPO11/WPO11.msi/Binary.NewBinary25

Text File | 2003-04-15 | 5KB | 153 lines

Option Explicit

Const msiNoAction = -1
Const msiInstallStateAdvertise = 1
Const msiInstallStateAbsent = 2
Const msiInstallStateLocal = 3
Const msiInstallStateSource = 4
Const msiInstallStateDefault = 5

'*********************************************************************************************
'    Sub:        setRequiredFeatures
'
'    Args:        none
'
'    Returns:    none
'
'    Notes:    - reads data from `FeaturesRequired1
'            - sets `FeaturesRequired`.`RequiredFeature` to be installed if `FeaturesRequired`.`Feature_` is going to be installed
'            - limitations : will not update the Selection tree at real time
'            - important : data is not validated, if there is an error in `FeaturesRequired` the install sub will fail
'
'*********************************************************************************************
Sub setRequiredFeatures

On Error Resume Next
    Dim sFeature, sFeatures()
    Dim sReqFeature, sReqFeatures()

    getFeatures "", sFeatures

    For Each sFeature in sFeatures

        If (IsFeatureSelected(sFeature)) Then

            getFeatures sFeature, sReqFeatures

            For Each sReqFeature in sReqFeatures
                If (Not (IsFeatureSelected(sReqFeature))) Then
                    Session.FeatureRequestState(sReqFeature) = msiInstallStateLocal
                End If
            Next
        End If

    Next
End Sub


'*********************************************************************************************
'    Sub:        getFeatures(sFeature, BYREF anArr)
'
'    Args:        STRING sFeature    -> if "" then * are selected from `FeaturesRequired`.`Feature_`
'                        -> if Not "" then * are selected from `FeaturesRequired`.`RequiredFeature` ...
'                            where `FeaturesRequired`.`Feature_` = sFeature
'            ARRAY anArr        -> results
'
'    Notes:    - no duplicate entries are returned
'
'*********************************************************************************************
Sub getFeatures(sFeature, BYREF anArr)
On Error Resume Next
    Dim objRec, sFeatures, sCurFeature, sQuery, x
    Dim objDB: Set objDB = Session.Database

    If (sFeature = "") Then
        sQuery = "SELECT `FeaturesRequired`.`Feature_` FROM `FeaturesRequired` ORDER BY `FeaturesRequired`.`Feature_`"
    Else
        sQuery = "SELECT `FeaturesRequired`.`RequiredFeature` FROM `FeaturesRequired` WHERE `FeaturesRequired`.`Feature_` = '" & sFeature & "' ORDER BY `FeaturesRequired`.`Feature_`"
    End If

    Dim objView: Set objView = objDB.OpenView(sQuery)

    objView.Execute

    sFeatures = ""
    sCurFeature = ""
    x = 0

    Do
        Set objRec = objView.Fetch

        If (objRec Is Nothing) Then
            Exit Do
        Else

            If (sCurFeature <> objRec.StringData(1)) Then
                If (sFeatures <> "") Then
                    sFeatures = sFeatures & ","
                End If

                If (x = 0) Then
                    ReDim anArr(0)
                Else
                    ReDim Preserve anArr(Ubound(anArr) + 1)
                End If

                anArr(Ubound(anArr)) = objRec.StringData(1)
                sCurFeature = objRec.StringData(1)
                x = 1
            End If
        End If
    Loop

End Sub


'*********************************************************************************************
'    Function:    getFeatureAction(sFeature)
'
'    Args:        STRING sFeature = `Feature`.`Feature`
'
'    Returns:    The current install state of the feature
'
'*********************************************************************************************
Function getFeatureState(sFeature)
On Error Resume Next
    getFeatureState = Session.FeatureCurrentState(sFeature)
End Function

'*********************************************************************************************
'    Function:    getFeatureAction(sFeature)
'
'    Args:        STRING sFeature = `Feature`.`Feature`
'
'    Returns:    The requested action of the feature
'
'*********************************************************************************************
Function getFeatureAction(sFeature)
On Error Resume Next
    getFeatureAction = Session.FeatureRequestState(sFeature)
End Function


'*********************************************************************************************
'    Function:    IsFeatureSelected(sFeature)
'
'    Args:        STRING sFeature = `Feature`.`Feature`
'
'    Returns:    True \ False
'
'    Notes:        Determines if a feature is selected for install
'*********************************************************************************************
Function IsFeatureSelected(sFeature)
On Error Resume Next
    Dim nState: nState = getFeatureState(sFeature)
    Dim nAction: nAction = getFeatureAction(sFeature)

    If ((nAction > msiInstallStateAbsent) Or ((nState > msiInstallStateAbsent) And (nAction = msiNoAction))) Then
        IsFeatureSelected = True
    Else
        IsFeatureSelected = False
    End If

End Function