Windows Installer API (SDK)
Registry Table
Referenz » Registry Table | Microsoft Docs
VBS class Registry
Class classRegistryTable
Private mRegistry, mRoot, mKey, mName, mValue, mComponent, mType
Public Property Get pRegistry
pRegistry = mRegistry
End Property
Public Property Let pRegistry(strRegistry)
mRegistry = strRegistry
End Property
Public Property Get pRoot
pRoot = mRoot
End Property
Public Property Let pRoot(intRoot)
mRoot = intRoot
End Property
Public Property Get pKey
pKey = mKey
End Property
Public Property Let pKey(strKey)
mKey = strKey
End Property
Public Property Get pName
pName = mName
End Property
Public Property Let pName(strName)
mName = strName
End Property
Public Property Get pValue
pValue = mValue
End Property
Public Property Let pValue(strValue)
mValue = strValue
End Property
Public Property Get pComponent
pComponent = mComponent
End Property
Public Property Let pComponent(strComponent)
mComponent = strComponent
End Property
Public Property Get pType
pType = mType
End Property
Public Property Let pType(strType)
mType = strType
End Property
Private Sub Class_Initialize
'Anweisungen
End Sub
' -----------------------------------------------------------------
Public Function ModifyRegistryRecord()
Dim strSQL, objView, objTableRow
strSQL = "SELECT * FROM Registry"
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) = mRegistry
objTableRow.IntegerData(2) = mRoot
objTableRow.StringData(3) = mKey
objTableRow.StringData(4) = mName
objTableRow.StringData(5) = mValue
objTableRow.StringData(6) = mComponent
objView.Modify msiViewModifyAssign, objTableRow
Exit Do
End If
objTableRow.StringData(1) = mRegistry
objTableRow.IntegerData(2) = mRoot
objTableRow.StringData(3) = mKey
objTableRow.StringData(4) = mName
objTableRow.StringData(5) = mValue
objTableRow.StringData(6) = mComponent
objView.Modify msiViewModifyAssign, objTableRow
Loop
objDatabase.Commit()
objView.Close
Set objView = Nothing
End Function
' -----------------------------------------------------------------
Public Function WriteRegistryRecordsFromFile(RegFile)
Dim objFSO, objRegistryFile, strLinetoParse, Pos, Pos1, Pos2, arrToParse, arrTypeValues
Dim strRegHive, strValue, temporare, strRegType
temporare = ""
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRegistryFile = objFSO.OpenTextFile(RegFile,ForReading,False,TristateUseDefault)
Do While Not objRegistryFile.AtEndOfStream
strLinetoParse = objRegistryFile.Readline
If Left(strLinetoParse,1) = ";" OR _
Left(strLinetoParse,1) = "#" OR _
Left(strLinetoParse,1) = "'" Then
' ignore comment lines
Else
If InStr(1,strLinetoParse, "\\", vbTextCompare) Then
strLinetoParse = Replace(strLinetoParse, "\\", "\")
End If
If temporare <> "" AND InStrRev(strLinetoParse, ",\",-1,vbTextCompare) Then
temporare = temporare & strLinetoParse
ElseIf temporare <> "" AND NOT InStrRev(strLinetoParse, ",\",-1,vbTextCompare) Then
temporare = temporare & strLinetoParse
temporare = Replace(temporare, ",", "")
temporare = Replace(temporare, " ", "")
temporare = Replace(temporare, "\", "")
If InStr(1,temporare, "000000", vbTextCompare) Then
temporare = Replace(temporare, "000000", "00[˜]")
End If
If InStr(1,temporare, "0000", vbTextCompare) Then
temporare = Replace(temporare, "0000", "[˜]")
End If
mRegistry = "RM" & Mid(Replace(GenerateGUID, "-", "", vbTextCompare),2,30)
mValue = temporare
ModifyRegistryRecord
temporare = ""
End If
If InStr(1,strLinetoParse, "=", vbTextCompare) Then
arrToParse = split(strLinetoParse, "=", -1, vbTextCompare)
If UBound(arrToParse) > 1 Then
strValue = Mid(strLinetoParse, InStr(1,strLinetoParse, "=", vbTextCompare) + 1)
Else
strValue = arrToParse(1)
End If
mName = arrToParse(0)
If Left(arrToParse(0),1) = Chr(34) AND Right(arrToParse(0),1) = Chr(34) Then _
mName = Mid(arrToParse(0), 2, Len(arrToParse(0)) - 2)
If InStr(1,strValue, ":", vbTextCompare) Then
arrTypeValues = split(strValue, ":", -1, vbTextCompare)
strRegType = arrTypeValues(0)
mValue = arrTypeValues(1)
Select Case strRegType
Case "dword"
mType = "REG_DWORD"
If IsNumeric(arrTypeValues(1)) Then
mValue = "#" & arrTypeValues(1)
Else
mValue = "#x" & arrTypeValues(1)
End If
Case "hex"
mType = "REG_BINARY"
mValue = "#x" & arrTypeValues(1)
Case "hex(0)"
mType = "REG_NONE"
mValue = "#x" & arrTypeValues(1)
Case "hex(2)"
mType = "REG_EXPAND_SZ"
mValue = "#%" & arrTypeValues(1)
Case "hex(7)"
mType = "REG_MULTI_SZ"
mValue = "[˜]" & arrTypeValues(1)
Case "hex(11)", "hex(b)"
mType = "REG_QWORD"
mValue = "#x" & arrTypeValues(1)
Case Else
End Select
If InStrRev(mValue, ",\",-1,vbTextCompare) Then
temporare = mValue
Else
If InStr(1,mValue, ",", vbTextCompare) Then _
mValue = Replace(mValue, ",", "")
mRegistry = "RM" & Mid(Replace(GenerateGUID, "-", "", vbTextCompare),2,30)
ModifyRegistryRecord
End If
Else
mType = "REG_SZ"
mValue = strValue
If Left(mValue,1) = Chr(34) AND Right(mValue,1) = Chr(34) Then _
mValue = Mid(mValue, 2, Len(mValue) - 2)
If Len(mValue) = 2 AND mValue = Chr(34) & Chr(34) Then _
mValue = ""
' masquerade {}
If Left(mValue,1) = "{" AND Right(mValue,1) = "}" Then
Pos1 = InStr(1,mValue, "{", vbTextCompare)
Pos2 = InStr(Pos1 + 1,mValue, "}", vbTextCompare)
mValue = "[\{]" & Mid(mValue,Pos1 + 1,Pos2 - 2) & "[\}]"
End If
' masquerade []
If Left(mValue,1) = "[" AND Right(mValue,1) = "]" Then
Pos1 = InStr(1,mValue, "[", vbTextCompare)
Pos2 = InStr(Pos1 + 1,mValue, "]", vbTextCompare)
mValue = "[\[]" & Mid(mValue,Pos1 + 1,Pos2 - 2) & "[\]]"
End If
mRegistry = "RM" & Mid(Replace(GenerateGUID, "-", "", vbTextCompare),2,30)
ModifyRegistryRecord
End If
End If
If Left(strLinetoParse,1) = "[" AND Right(strLinetoParse,1) = "]" Then
Pos = InStr(1,strLinetoParse, "\", vbTextCompare)
strRegHive = Mid(strLinetoParse,2,Pos - 2)
mKey = Mid(strLinetoParse, Pos + 1, Len(strLinetoParse) - (Pos + 1))
Select Case strRegHive
Case "HKEY_CLASSES_ROOT"
mRoot = CInt("0")
mComponent = "HKCR"
mName = "*"
msiFeatureComponents.pFeature = "Complete"
Case "HKEY_CURRENT_USER"
mRoot = CInt("1")
mComponent = "HKCU"
mName = "+"
msiFeatureComponents.pFeature = "CurrentUser"
Case "HKEY_LOCAL_MACHINE"
mRoot = CInt("2")
mComponent = "HKLM"
mName = "*"
msiFeatureComponents.pFeature = "Complete"
Case "HKEY_USERS"
mRoot = CInt("3")
mComponent = "HKU"
mName = "*"
msiFeatureComponents.pFeature = "Complete"
Case Else
End Select
mRegistry = "RM" & Mid(Replace(GenerateGUID, "-", "", vbTextCompare),2,30)
mValue = ""
ModifyRegistryRecord
If msiComponent.ThereAreDuplicateComponentRecords <> mComponent Then
msiComponent.pComponent = mComponent
msiComponent.pComponentId = GenerateGUID
msiComponent.pDirectory = "TARGETDIR"
msiComponent.pAttributes = msiComponent.SetAttributesOfComponent
msiComponent.pCondition = ""
msiComponent.pKeyPath = ""
msiComponent.ModifyComponentRecord
msiFeatureComponents.pComponent = mComponent
msiFeatureComponents.ModifyFeatureComponentsRecord
End If
End If
End If
Loop
objRegistryFile.Close
Set objRegistryFile = Nothing
Set objFSO = Nothing
End Function
' -----------------------------------------------------------------
Public Function InitializeFilePerUserDirectory()
' user-defined files must have a Registry Keypath and an entry
' in the registry table.
mRegistry = "HKCU_" & msiComponent.pComponent
mRoot = 1
mKey = "Software\[ProductName]\ActiveSelfRepair"
mName = "IsInstalled_" & msiFile.pFile
mValue = "True"
mComponent = msiComponent.pComponent
End Function
' -----------------------------------------------------------------
Public Function DeleteRegistryRecord()
Dim strSQL, objView, objTableRow
strSQL = "SELECT * FROM Registry"
Set objView = objDatabase.OpenView(strSQL)
objView.Execute
Do
Set objTableRow = objView.Fetch
If objTableRow Is Nothing Then Exit Do
If objTableRow.StringData(6) = mComponent Then _
objView.Modify msiViewModifyDelete, objTableRow
Loop
objDatabase.Commit()
objView.Close
Set objView = Nothing
End Function
' -----------------------------------------------------------------
Public Function DeleteAllRecords()
Dim strSQL, objView
strSQL = "DELETE FROM Registry"
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 Registry"
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
' ---------------------------------------------------------------------