Windows Installer API (SDK)
Component Table
Referenz » Component Table | Microsoft Docs
VBS class Component
Class classComponentTable
Private mComponent, mComponentId, mDirectory, mAttributes, mCondition, mKeyPath
Public Property Get pComponent
pComponent = mComponent
End Property
Public Property Let pComponent(strComponent)
mComponent = strComponent
End Property
Public Property Get pComponentId
pComponentId = mComponentId
End Property
Public Property Let pComponentId(strComponentId)
mComponentId = strComponentId
End Property
Public Property Get pDirectory
pDirectory = mDirectory
End Property
Public Property Let pDirectory(strDirectory)
mDirectory = strDirectory
End Property
Public Property Get pAttributes
pAttributes = mAttributes
End Property
Public Property Let pAttributes(intAttributes)
mAttributes = intAttributes
End Property
Public Property Get pCondition
pCondition = mCondition
End Property
Public Property Let pCondition(strCondition)
mCondition = strCondition
End Property
Public Property Get pKeyPath
pKeyPath = mKeyPath
End Property
Public Property Let pKeyPath(strKeyPath)
mKeyPath = strKeyPath
End Property
Private Sub Class'Initialize
If InStr(1, mComponent, "{", vbTextCompare) Then '
mComponent = Replace(mComponent, "{", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "}", vbTextCompare) Then '
mComponent = Replace(mComponent, "}", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "‐", vbTextCompare) Then '
mComponent = Replace(mComponent, "‐", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "+", vbTextCompare) Then '
mComponent = Replace(mComponent, "+", "Plus", 1, -1, vbTextCompare)
If InStr(1, mComponent, "'", vbTextCompare) Then '
mComponent = Replace(mComponent, "'", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, " ", vbTextCompare) Then '
mComponent = Replace(mComponent, " ", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, ".", vbTextCompare) Then '
mComponent = Replace(mComponent, ".", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "'", vbTextCompare) Then '
mComponent = Replace(mComponent, "'", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "´", vbTextCompare) Then '
mComponent = Replace(mComponent, "´", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "`", vbTextCompare) Then '
mComponent = Replace(mComponent, "`", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "(", vbTextCompare) Then '
mComponent = Replace(mComponent, "(", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, ")", vbTextCompare) Then '
mComponent = Replace(mComponent, ")", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, "@", vbTextCompare) Then '
mComponent = Replace(mComponent, "@", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, ",", vbTextCompare) Then '
mComponent = Replace(mComponent, ",", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, ";", vbTextCompare) Then '
mComponent = Replace(mComponent, ";", "", 1, -1, vbTextCompare)
If InStr(1, mComponent, ":", vbTextCompare) Then '
mComponent = Replace(mComponent, ":", "", 1, -1, vbTextCompare)
End Sub
' ------------------------------------------------------------------
Public Function CreateTable()
Dim strSQL, objView, objTableRow
strSQL = "CREATE TABLE " & Chr(96) & "Component" & Chr(96) & " (" & '
Chr(96) & "Component" & Chr(96) & " CHAR(72) NOT NULL, " & '
Chr(96) & "ComponentId" & Chr(96) & " CHAR(38) NOT NULL, " & '
Chr(96) & "Directory'" & Chr(96) & " CHAR(72) NOT NULL, " & '
Chr(96) & "Attributes" & Chr(96) & " SHORT NOT NULL, " & '
Chr(96) & "Condition" & Chr(96) & " CHAR(255), " & '
Chr(96) & "KeyPath" & Chr(96) & " CHAR(72) PRIMARY KEY " & '
Chr(96) & "Component" & Chr(96) & ")"
Set objView = objDatabase.OpenView(strSQL)
objView.Execute
objDatabase.Commit()
msiValidation.pTable = "Component"
msiValidation.pColumn = "Condition"
msiValidation.pNullable = "Y"
msiValidation.pMinValue = Null
msiValidation.pMaxValue = Null
msiValidation.pKeyTable = ""
msiValidation.pKeyColumn = Null
msiValidation.pCategory = "Condition"
msiValidation.pSet = ""
msiValidation.pDescription = "A conditional statement that will disable this " & '
"component if the specified condition evaluates to the 'True' state. " & '
"If a component is disabled, it will not be installed, regardless of " & '
"the 'Action' state associated with the component."
msiValidation.ModifyValidationRecord
msiValidation.ResetValidationRecord
msiValidation.pTable = "Component"
msiValidation.pColumn = "Attributes"
msiValidation.pNullable = "N"
msiValidation.pMinValue = Null
msiValidation.pMaxValue = Null
msiValidation.pKeyTable = ""
msiValidation.pKeyColumn = Null
msiValidation.pCategory = ""
msiValidation.pSet = ""
msiValidation.pDescription = "Remote execution option, one of irsEnum"
msiValidation.ModifyValidationRecord
msiValidation.ResetValidationRecord
msiValidation.pTable = "Component"
msiValidation.pColumn = "ComponentId"
msiValidation.pNullable = "Y"
msiValidation.pMinValue = Null
msiValidation.pMaxValue = Null
msiValidation.pKeyTable = ""
msiValidation.pKeyColumn = Null
msiValidation.pCategory = "Guid"
msiValidation.pSet = ""
msiValidation.pDescription = "A string GUID unique to this component, version, " & '
"and language."
msiValidation.ModifyValidationRecord
msiValidation.ResetValidationRecord
msiValidation.pTable = "Component"
msiValidation.pColumn = "Component"
msiValidation.pNullable = "N"
msiValidation.pMinValue = Null
msiValidation.pMaxValue = Null
msiValidation.pKeyTable = ""
msiValidation.pKeyColumn = Null
msiValidation.pCategory = "Identifier"
msiValidation.pSet = ""
msiValidation.pDescription = "Primary key used to identify a particular " & '
"component record."
msiValidation.ModifyValidationRecord
msiValidation.ResetValidationRecord
msiValidation.pTable = "Component"
msiValidation.pColumn = "Directory'"
msiValidation.pNullable = "N"
msiValidation.pMinValue = Null
msiValidation.pMaxValue = Null
msiValidation.pKeyTable = "File;Registry;ODBCDataSource"
msiValidation.pKeyColumn = CStr("1")
msiValidation.pCategory = "Identifier"
msiValidation.pSet = ""
msiValidation.pDescription = "Required key of a Directory table record. This is " & '
"actually a property name whose value contains the actual path, set " & '
"either by the AppSearch action or with the default setting obtained " & '
"from the Directory table."
msiValidation.ModifyValidationRecord
msiValidation.ResetValidationRecord
Set objView = Nothing
End Function
' ------------------------------------------------------------------
Public Function ModifyComponentRecord()
Dim strSQL, objView, objTableRow
strSQL = "SELECT * FROM Component"
Set objView = objDatabase.OpenView(strSQL)
objView.Execute
Do
Set objTableRow = objView.Fetch
If objTableRow Is Nothing Then
Set objTableRow = objInstaller.CreateRecord(6)
objTableRow.StringData(1) = mComponent
objTableRow.StringData(2) = mComponentId
objTableRow.StringData(3) = mDirectory
objTableRow.IntegerData(4) = SetAttributesOfComponent ' mAttributes
objTableRow.StringData(5) = mCondition
objTableRow.StringData(6) = mKeyPath
objView.Modify msiViewModifyAssign, objTableRow
Exit Do
End If
objTableRow.StringData(1) = mComponent
objTableRow.StringData(2) = mComponentId
objTableRow.StringData(3) = mDirectory
objTableRow.IntegerData(4) = SetAttributesOfComponent ' mAttributes
objTableRow.StringData(5) = mCondition
objTableRow.StringData(6) = mKeyPath
objView.Modify msiViewModifyAssign, objTableRow
Loop
objDatabase.Commit()
objView.Close
Set objView = Nothing
End Function
' ------------------------------------------------------------------
Public Function SetAttributesOfComponent()
Dim AttributesOfComponent
AttributesOfComponent = 0
If ApplicationInfo.pArchitecture = "x64" Then
AttributesOfComponent = msiComponentAttributes64bit
Else
AttributesOfComponent = msiComponentAttributesLocalOnly
End If
If FolderDataInfo.Feature = "CurrentUser" OR '
msiRegistry.pComponent = mComponent Then
AttributesOfComponent = AttributesOfComponent + '
msiComponentAttributesRegistryKeyPath
End If
If msiDirectory.pDirectory = "SystemFolder" Then
AttributesOfComponent = AttributesOfComponent + '
msiComponentAttributesSharedDllRefCount + '
msiComponentAttributesPermanent
End If
SetAttributesOfComponent = AttributesOfComponent
End Function
' ------------------------------------------------------------------
Public Function ExcludeDuplicateComponentKeys(strComponentName)
Dim objView, objRecord, strSQL
Dim intPOS, intCount, strTemp
intCount = ""
strTemp = ""
strSQL = "SELECT Component.Component FROM Component"
Set objView = objDatabase.OpenView(strSQL)
objView.Execute
Do
Set objRecord = objView.Fetch
If objRecord Is Nothing Then Exit Do
If Instr(1, objRecord.StringData(1), strComponentName & "'", vbTextCompare) Then
intPOS = InStrRev(objRecord.StringData(1), "'", -1, 1)
intCount = Mid(objRecord.StringData(1), intPOS + 1)
If IsNumeric(intCount) AND intCount <> "" Then
strTemp = strComponentName & "'" & CStr(CInt(intCount) + 1)
End If
ElseIf objRecord.StringData(1) = strComponentName Then
If Right(objRecord.StringData(1), 2) <> "'1" Then
strTemp = strComponentName & "'1"
End If
End If
Loop
If strTemp <> "" Then
mComponent = strTemp
Else
mComponent = strComponentName
End If
If IsObject(objRecord) Then Set objRecord = Nothing
Set objView = Nothing
End Function
' ------------------------------------------------------------------
Public Function ThereAreDuplicateComponentRecords()
Dim strSQL, objView, objTableRow
strSQL = "SELECT * FROM Component"
Set objView = objDatabase.OpenView(strSQL)
objView.Execute
Do
Set objTableRow = objView.Fetch
If objTableRow Is Nothing Then Exit Do
If objTableRow.StringData(1) = mComponent Then
ThereAreDuplicateComponentRecords = objTableRow.StringData(1)
Exit Do
End If
Loop
objView.Close
Set objView = Nothing
End Function
' ------------------------------------------------------------------
Public Function DeleteComponentRecord()
Dim strSQL, objView, objTableRow
strSQL = "SELECT * FROM Component"
Set objView = objDatabase.OpenView(strSQL)
objView.Execute
Do
Set objTableRow = objView.Fetch
If objTableRow Is Nothing Then Exit Do
If objTableRow.StringData(1) = mComponent Then '
objView.Modify msiViewModifyDelete, objTableRow
Loop
objDatabase.Commit()
objView.Close
Set objView = Nothing
End Function
' ------------------------------------------------------------------
Private Function GenerateGUID()
Dim objGuid
Set objGuid = CreateObject("Scriptlet.Typelib")
GenerateGUID = Left(objGuid.Guid, 38)
Set objGuid = Nothing
End Function
' -----------------------------------------------------------------
Private Sub Class'Terminate()
'Anweisungen
End Sub
End Class
' ----------------------------------------------------------------------