VBScripting
VBS class Registry
Class classRegistry
Private HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS
Private HKEY_PERFORMANCE_DATA, HKEY_CURRENT_CONFIG, HKEY_DYN_DATA
Private REG_NONE, REG_SZ, REG_EXPAND_SZ, REG_BINARY, REG_DWORD, REG_DWORD_BIG_ENDIAN
Private REG_LINK, REG_MULTI_SZ, REG_RESOURCE_LIST, REG_FULL_RESOURCE_DESCRIPTOR
Private REG_RESOURCE_REQUIREMENTS_LIST, REG_QWORD
Private KEY_QUERY_VALUE, KEY_SET_VALUE, KEY_CREATE_SUB_KEY, KEY_ENUMERATE_SUB_KEYS
Private mHiveName, mHive, mKey, mName, mValue, mType
Public Property Get pHiveName
pHiveName = mHiveName
End Property
Public Property Let pHiveName(strHiveName)
mHiveName = strHiveName
End Property
Public Property Get pHive
pHive = mHive
End Property
Public Property Let pHive(strHive)
mHive = strHive
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 pType
pType = mType
End Property
Public Property Let pType(strType)
mType = strType
End Property
Private Sub Class_Initialize
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &h80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
REG_NONE = 0
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
REG_DWORD = 4
REG_DWORD_BIG_ENDIAN = 5
REG_LINK = 6
REG_MULTI_SZ = 7
REG_RESOURCE_LIST = 8
REG_FULL_RESOURCE_DESCRIPTOR = 9
REG_RESOURCE_REQUIREMENTS_LIST = 10
REG_QWORD = 11
KEY_QUERY_VALUE = &H0001
KEY_SET_VALUE = &H0002
KEY_CREATE_SUB_KEY = &H0004
KEY_ENUMERATE_SUB_KEYS = &H0008
End Sub
' -----------------------------------------------------------------
Public Function GetRegFilesFromSource(strFolder)
Dim objFSO, objFolders, objFile, foundFiles
Dim strFileName, strFileBaseName, strFileExtName
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strFolder) Then
Set objFolders = objFSO.GetFolder(strFolder)
For Each foundFiles in objFolders.Files
Set objFile = objFSO.GetFile(foundFiles)
strFileName = objFile.Name
strFileBaseName = objFSO.GetBaseName(objFile.Name)
strFileExtName = objFSO.GetExtensionName(objFile.Name)
Select Case UCase(objFSO.GetExtensionName(objFile.Name))
Case "REG"
WriteLog " *** Information *** :: Initialize following registry file ... " & strFolder & strFileBaseName & "." & strFileExtName
InitializeRegistryRecordsFromFile strFolder & "\" & strFileBaseName & "." & strFileExtName
Case Else
End Select
Next
End If
Set objFile = Nothing
Set objFolders = Nothing
Set objFSO = Nothing
End Function
' -----------------------------------------------------------------
Public Function InitializeRegistryRecordsFromFile(RegFile)
Dim objFSO, objRegistryFile, strLinetoParse, arrToParse, arrTypeValues, Pos
Dim strRegistryKey, strRegType, strValue, temporare, TempArr
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRegistryFile = objFSO.OpenTextFile(RegFile, ForReading, False, TristateUseDefault)
temporare = ""
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 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, "\", "")
mValue = temporare
WriteRegistryRecordsFromFile
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
If Left(arrToParse(0),1) = Chr(34) AND Right(arrToParse(0),1) = Chr(34) Then
mName = Mid(arrToParse(0), 2, Len(arrToParse(0)) - 2)
Else
mName = arrToParse(0)
End If
If Len(strValue) = 2 AND strValue = Chr(34) & Chr(34) Then _
strValue = ""
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"
Case "hex"
mType = "REG_BINARY"
Case "hex(0)"
mType = "REG_NONE"
Case "hex(2)"
mType = "REG_EXPAND_SZ"
Case "hex(7)"
mType = "REG_MULTI_SZ"
Case "hex(11)", "hex(b)"
mType = "REG_QWORD"
Case Else
End Select
Else
mType = "REG_SZ"
mValue = strValue
If Left(strValue,1) = Chr(34) AND Right(strValue,1) = Chr(34) Then _
mValue = Mid(strValue, 2, Len(strValue) - 2)
If InStr(1,strValue, "\\", vbTextCompare) Then
TempArr = split(strValue, "\\", -1, vbTextCompare)
If UBound(arrToParse) > 1 Then
mValue = Replace(strValue, "\\", "\")
End If
End If
If InStrRev(mValue, ",\",-1,vbTextCompare) Then
temporare = mValue
Else
WriteRegistryRecordsFromFile
End If
End If
If Left(strLinetoParse,1) = "[" AND Right(strLinetoParse,1) = "]" Then
Pos = InStr(1,strLinetoParse, "\", vbTextCompare)
mHiveName = Mid(strLinetoParse, 2, Pos - 2)
mHive = Mid(strLinetoParse, 2, Pos - 2)
mKey = Mid(strLinetoParse, Pos + 1, Len(strLinetoParse) - (Pos + 1))
If mHive <> "" Then
Select Case mHive
Case "HKEY_CLASSES_ROOT"
mHive = &h80000000
strRegistryKey = mKey
Case "HKEY_CURRENT_USER"
mHive = &h80000003
strRegistryKey = DomainUser.pSID & "\" & mKey
Case "HKEY_LOCAL_MACHINE"
mHive = &h80000002
strRegistryKey = mKey
Case "HKEY_USERS"
mHive = &H80000003
strRegistryKey = DomainUser.pSID & "\" & mKey
Case Else
End Select
mKey = strRegistryKey
' clean up
mType = ""
mName = ""
mValue = ""
End If
End If
End If
Loop
objRegistryFile.Close
Set objRegistryFile = Nothing
Set objFSO = Nothing
End Function
' -----------------------------------------------------------------
Public Function WriteRegistryRecordsFromFile()
Dim ReturnToSender, strHKEY
strHKEY = mHiveName
If DomainUser.pSID <> "" Then
ReturnToSender = CreateRegistryValues(mHive, mKey, mName, mValue, mType)
If ReturnToSender <> 0 Then
ReturnToSender = CreateRegistryKeys(mHive, mKey)
If ReturnToSender <> 0 Then
WriteLog " !!! FAILED !!! :: Unable to create the registry key :: '" & strHKEY & "\" & mKey & "'"
WriteLog " !!! ------ !!! :: ......................................"
Else
ReturnToSender = CreateRegistryValues(mHive, mKey, mName, mValue, mType)
If ReturnToSender <> 0 Then
WriteLog " !!! FAILED !!! :: Unable to write the registry value :: '" & strHKEY & "\" & mKey & "'"
WriteLog " !!! FAILED !!! :: :: '" & mName & " = " & mValue & "'"
WriteLog " !!! FAILED !!! :: ......................................."
Else
WriteLog " *** Information *** :: Successfully write the registry value :: '" & strHKEY & "\" & mKey & "'"
WriteLog " *** Information *** :: :: '" & mName & " = " & mValue & "'"
WriteLog " *** ----------- *** :: .........................................."
End If
End If
Else
WriteLog " *** Information *** :: Successfully write the registry value :: '" & strHKEY & "\" & mKey & "'"
WriteLog " *** Information *** :: :: '" & mName & " = " & mValue & "'"
WriteLog " *** ----------- *** :: .........................................."
End If
Else
WriteLog " !!! FAILED !!! :: Unable to received the information about the last or current loggedon user !!"
WriteLog " !!! FAILED !!! :: Unable to write the necessary adjustments in the registry !"
WriteLog " !!! ------ !!! :: ..........................................................."
End If
End Function
' -----------------------------------------------------------------
Public Function CreateRegistryKeys(strHKEY, strRegKey)
Dim objReg, strComputer
strComputer = "."
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
CreateRegistryKeys = objReg.CreateKey(strHKEY, strRegKey)
Set objReg = Nothing
End Function
' -----------------------------------------------------------------
Public Function CreateRegistryValues(strHKEY, strKeyPath, strValueName, strValue, strValueTypes)
Dim objReg, strComputer
strComputer = "."
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
Select Case strValueTypes
Case "REG_SZ"
CreateRegistryValues = objReg.SetStringValue(strHKEY, strKeyPath, strValueName, strValue)
Case "REG_EXPAND_SZ"
CreateRegistryValues = objReg.SetExpandedStringValue(strHKEY, strKeyPath, strValueName, strValue)
Case "REG_DWORD"
CreateRegistryValues = objReg.SetDWORDValue(strHKEY, strKeyPath, strValueName, strValue)
Case "REG_BINARY"
CreateRegistryValues = objReg.SetBinarValue(strHKEY, strKeyPath, strValueName, strValue)
Case "REG_MULTI_SZ"
CreateRegistryValues = objReg.SetMultiStringValue(strHKEY, strKeyPath, strValueName, strValue)
Case "REG_QWORD"
CreateRegistryValues = objReg.SetQWORDValue(strHKEY, strKeyPath, strValueName, strValue)
End Select
Set objReg = Nothing
End Function
' -----------------------------------------------------------------
Public Function RemoveRegistryKeys(strHKEY, strKeyPath)
Dim objReg, strComputer, arrSubKeys, subkey, ReturnToSender
strComputer = "."
strHKEY = mHiveName
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
ReturnToSender = objReg.EnumKey(strHKEY, strKeyPath, arrSubKeys)
If IsArray(arrSubKeys) Then
For Each subkey In arrSubKeys
ReturnToSender = RemoveRegistryKeys(strHKEY, strKeyPath & "\" & subkey)
Next
End If
ReturnToSender = objReg.DeleteKey(strHKEY, strKeyPath)
If ReturnToSender <> 0 Then
WriteLog " !!! FAILED !!! :: Unable to remove registry key :: '" & strHKEY & "\" & strKeyPath & "'"
WriteLog " !!! ------ !!! :: ..................................."
Else
WriteLog " *** Information *** :: Successfully removed the registry key :: '" & strHKEY & "\" & strKeyPath & "'"
WriteLog " *** ----------- *** :: .........................................."
End If
Set objReg = Nothing
End Function
' -----------------------------------------------------------------
Public Sub WriteLogFile(Message)
Dim objFSO, objLogFile, PathOfLogFile, NameOfLogFile
' ---
PathOfLogFile = "C:\Windows\Logs\Software"
NameOfLogFile = PathOfLogFile & "\DB2connectivity_install.log"
' ---
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.OpenTextFile(NameOfLogFile, 8, true)
objLogFile.WriteLine("[" & Now & "] [Logging:] " & Message)
objLogFile.Close
Set objFSO = Nothing
End Sub
' -----------------------------------------------------------------
Public Function WriteLog(strMessage)
Dim MsgRec
Set MsgRec = Session.Installer.CreateRecord(1)
MsgRec.StringData(0) = "VBS_CA LOG (CA_ProcessAllRegistryFiles): " & Time & "[1] "
MsgRec.StringData(1) = " " & strMessage
Session.Message msiMessageTypeInfo, MsgRec
End Function
' -----------------------------------------------------------------
Private Sub Class_Terminate()
'Instructions
End Sub
End Class
' ----------------------------------------------------------------------