Windows Installer API (SDK)

Font Table

Referenz » Font Table | Microsoft Docs

VBS class Font

Class classFontTable
Private mFile, mFontTitle

    Public Property Get pFile
        pFile = mFile
    End Property
    Public Property Let pFile(strFile)
        mFile = strFile
    End Property
    Public Property Get pFontTitle
        pFontTitle = mFontTitle
    End Property
    Public Property Let pFontTitle(strFontTitle)
        mFontTitle = strFontTitle
    End Property
    
    Private Sub Class_Initialize
        'Anweisungen
    End Sub
    ' -----------------------------------------------------------------

    Public Function CreateTable()
    Dim strSQL, objView, objTableRow

    strSQL = "CREATE TABLE " & Chr(96) & "Font" & Chr(96) & " (" & _
                 Chr(96) & "File_" & Chr(96) & " CHAR(72) NOT NULL, " & _
                 Chr(96) & "FontTitle" & Chr(96) & " CHAR(128) PRIMARY KEY , " & _
                 Chr(96) & "File_" & Chr(96) & ")"

    Set objView = objDatabase.OpenView(strSQL)
    objView.Execute
    objDatabase.Commit()

    msiValidation.pTable = "Font"
    msiValidation.pColumn = "File_"
    msiValidation.pNullable = "N"
    msiValidation.pMinValue = Null
    msiValidation.pMaxValue = Null
    msiValidation.pKeyTable = "File"
    msiValidation.pKeyColumn = 1
    msiValidation.pCategory = "Identifier"
    msiValidation.pSet = ""
    msiValidation.pDescription = "Primary key, foreign key into File table referencing font file."

        msiValidation.ModifyValidationRecord
        msiValidation.ResetValidationRecord

    msiValidation.pTable = "Font"
    msiValidation.pColumn = "FontTitle"
    msiValidation.pNullable = "Y"
    msiValidation.pMinValue = Null
    msiValidation.pMaxValue = Null
    msiValidation.pKeyTable = ""
    msiValidation.pKeyColumn = Null
    msiValidation.pCategory = "Text"
    msiValidation.pSet = ""
    msiValidation.pDescription = "Font name."

        msiValidation.ModifyValidationRecord
        msiValidation.ResetValidationRecord

    Set objView = Nothing
    
    End Function
    ' -----------------------------------------------------------------

    Public Function ModifyFontRecord()
    Dim strSQL, objView, objTableRow

    strSQL = "SELECT * FROM Font"

    Set objView = objDatabase.OpenView(strSQL)
    objView.Execute
    Do 
        Set objTableRow = objView.Fetch
        If objTableRow Is Nothing Then
            Set objTableRow = objInstaller.CreateRecord(2)
            objTableRow.StringData(1) = mFile
            objTableRow.StringData(2) = mFontTitle
            objView.Modify msiViewModifyAssign, objTableRow
            Exit Do
        End If
            objTableRow.StringData(1) = mFile
            objTableRow.StringData(2) = mFontTitle
            objView.Modify msiViewModifyAssign, objTableRow
    Loop
    objDatabase.Commit()
    objView.Close
    Set objView = Nothing

    End Function
    ' -----------------------------------------------------------------

    Public Function DeleteFontRecord()
    Dim strSQL, objView, objTableRow

    strSQL = "SELECT * FROM Font"

    Set objView = objDatabase.OpenView(strSQL)
    objView.Execute
        Do 
            Set objTableRow = objView.Fetch
            If objTableRow Is Nothing Then Exit Do
        
            If objTableRow.StringData(1) = mFile Then _
               objView.Modify msiViewModifyDelete, objTableRow
        Loop
    objDatabase.Commit()
    objView.Close
    Set objView = Nothing

    End Function
    ' -----------------------------------------------------------------

    Public Function DeleteAllRecords()
    Dim strSQL, objView

    strSQL = "DELETE FROM Font"

    Set objView = objDatabase.OpenView(strSQL)
        objView.Execute
    objDatabase.Commit()
        objView.Close
    Set objView = Nothing

    End Function
    ' -----------------------------------------------------------------

    Public Function DropTable()
    Dim strSQL, objView

    strSQL = "DROP TABLE Font"

    Set objView = objDatabase.OpenView(strSQL)
        objView.Execute
    objDatabase.Commit()
        objView.Close
    Set objView = Nothing

    End Function
    ' -----------------------------------------------------------------

    Private Sub Class_Terminate()
        'Anweisungen
    End Sub
End Class
' ---------------------------------------------------------------------