VBScript: How to add a HEX value into a registry key? - vbscript

binary data to insert(from .reg file):
"FailureActions"=hex:00,00,00,00,00,00,00,00,00,00,00,00,03,00,00,00,14,00,00,\
00,01,00,00,00,60,ea,00,00,01,00,00,00,60,ea,00,00,00,00,00,00,00,00,00,00
MSDN says: "RegWrite will write at most one DWORD to a REG_BINARY value. Larger values are not supported with this method."
wshShell.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Service1\FailureActions", hexValueHere, "REG_BINARY"
I am trying to avoid calling Regedit and importing a .reg file. I just need to add "FailureActions" key with the proper hex value mentioned above.
Any ideas? Here is my latest code which is still NOT working. :-(
Option Explicit
Call SetServiceFailureActions()
Sub SetServiceFailureActions()
Const HKEY_LOCAL_MACHINE = &H80000002
Set objRegistry=GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\" & _
"." & "\root\default:StdRegProv")
Dim path
path = "SYSTEM\CurrentControlSet\Services\Service1\FailureActions"
Dim hexValues, arrHexValues, arrDecValues
hexValues = "hex:00,00,00,00,00,00,00,00,00,00,00,00,03,00,00,00,14,00,00,00,01,00,00,00,60,ea,00,00,01,00,00,00,60,ea,00,00,00,00,00,00,00,00,00,00"
arrHexValues = Split(Replace(hexValues, "hex:", ""), ",")
arrDecValues = DecimalNumbers(arrHexValues)
Dim objRegistry, Return
Return = objRegistry.SetBinaryValue(HKEY_LOCAL_MACHINE, path, "FailureActions", arrDecValues)
If (Return = 0) And (Err.Number = 0) Then
Wscript.Echo "Registry key value for [FailureActions] has been added successfully."
Else
' An error occurred
Wscript.Echo "ERROR when setting the value for the registry key: [FailureActions]."
WScript.Echo "Exception:" & vbCrLf &_
"Error number: " & Err.Number & vbCrLf &_
"Error description: '" & Err.Description & vbCrLf
End If
End Sub
Function DecimalNumbers(arrHex)
Dim i, strDecValues
For i = 0 to Ubound(arrHex)
If isEmpty(strDecValues) Then
strDecValues = CLng("&H" & arrHex(i))
'WScript.Echo "strDecValues: " & strDecValues
Else
strDecValues = strDecValues & "," & CLng("&H" & arrHex(i))
'WScript.Echo "strDecValues: " & strDecValues
End If
next
DecimalNumbers = split(strDecValues, ",")
End Function
Thank you

You can use the WMI Registry Provider's SetBinaryValue method, as long as you don't have to support Windows XP: however note that this must run as an elevated process as it's a protected key:
Const HKEY_LOCAL_MACHINE = &H80000002
Set objRegistry = GetObject("Winmgmts:root\default:StdRegProv")
path = "SYSTEM\CurrentControlSet\Services\Service1"
values = Array(128,81,1,0,0,0,0,0) ' etc
Return = objRegistry.SetBinaryValue(HKEY_LOCAL_MACHINE, _
path, "FailureActions", values)
If (Return = 0) And (Err.Number = 0) Then
Wscript.Echo "Binary value added successfully"
Else
' An error occurred
End If

Related

Calling EnumKey in vbscript as custom action in an installer querying windows registry results in wbemErrNotFound

With the examples in here, I have created a vbscript which uses WMI registry object to enumerate the sub-keys on the registry key "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components". The vbscript runs fine and produces the result I need when I test it using WScript.
When I embedded the vbscript into in installer as a custom action, the EnumKey call returns error wbemErrNotFound(2). However, it could return successful result if I enumerate some other keys. Is it permission issue? I have tried running the installer in elevated privilege. How do I get it working with the installer?
For demonstrating the problem, below is a cut down version of the vbscript I am using:
Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_ENUMERATE_SUB_KEYS = &H00000008
Function CountSubKeys(nHiveRoot, sKeyPath)
Const sComputer = "." ' Use . for current machine
Dim nRet
Dim nSum
MsgBox "EnumKey: " & sKeyPath, vbOkOnly, "CountSubKeys"
' Set oReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & sComputer & "/root/default:StdRegProv" )
Set oReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & sComputer & "/root/cimv2:StdRegProv" )
Dim bGranted
nRet = oReg.CheckAccess(nHiveRoot, sKeyPath, KEY_ENUMERATE_SUB_KEYS, bGranted)
If (nRet = 0) Then
If bGranted = True Then
MsgBox "Access to key: " & sKeyPath & " is granted", vbOkOnly, "CountSubKeys"
Else
MsgBox "Access to key: " & sKeyPath & " is denied", vbOkOnly, "CountSubKeys"
End If
Else
MsgBox "Failed to check key access: " & sKeyPath & ", nRet: " & nRet, vbOkOnly, "CountSubKeys"
End If
nRet = oReg.EnumKey(nHiveRoot, sKeyPath, arrSubKeys)
If (nRet = 0) Then
If isArray(arrSubKeys) Then
nSum = UBound(arrSubKeys) + 1
MsgBox "Number of sub keys: " & nSum, vbOkOnly, "CountSubKeys"
Else
MsgBox "EnumKey return no sub key on path" & sKeyPath, vbOkOnly, "CountSubKeys"
nSum = 0
End If
Else
MsgBox "Failed to enum key: " & sKeyPath & ", Err: " & nRet, vbOkOnly, "CountSubKeys"
nSum = -1
End If
CountSubKeys = nSum
End Function
Sub TestEnumKey()
Const sInstalledComponentKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"
nCount = CountSubKeys(HKEY_LOCAL_MACHINE, sInstalledComponentKey)
MsgBox "nCount: " & nCount, vbOkOnly, "TestEnumKey"
End Sub
TestEnumKey()
The custom action uses the Sub TestEnumKey() as the entry point of the vbscrpt.
The error is not caused by permission of the registry key. It is due to the accessing of 64-bits registry on a 32-bits scripting host.
When I tested the vbscript using WScript, it is by default using the 64-bits scripting host and accessing the 64-bits registry by default and successfully enumerate the subkeys.
My installer is an 32-bits msi and therefore its custom action invokes 32-bits scripting host, which accesses the 32-bits registry by default, and of course cannot find the 64-bit registry key.

Read Windows Registry value into array

I have to read Windows Registry value into array in VBA. Value has type REG_MULTI_SZ.
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\Lsa\Authentication Packages"
strValueName = "Sources"
Return = objReg.GetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, _
strValueName, arrValues)
If (Return = 0) And (Err.Number = 0) Then
'Treat the multistring value as a collection of strings
'separated by spaces and output
For Each strValue In arrValues
WScript.Echo strValue
Next
Else
WScript.Echo "GetMultiStringValue failed. Error = " & Err.Number
End If
It gives an error with number 0 and no description. Any clue?
According to your screenshot your key is "Authentication Packages", not "Sources".
Change this:
strKeyPath = "SYSTEM\CurrentControlSet\Control\Lsa\Authentication Packages"
strValueName = "Sources"
into this:
strKeyPath = "SYSTEM\CurrentControlSet\Control\Lsa"
strValueName = "Authentication Packages"
It was a simple error. The working code is here.
const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\Lsa"
strValueName = "Authentication Packages"
Return = objReg.GetMultiStringValue(HKEY_LOCAL_MACHINE,strKeyPath, strValueName,arrValues)
WScript.Echo "GetMultiStringValue. Return = " & Return
If (Return = 0) And (Err.Number = 0) Then
' Treat the multistring value as a collection of strings
' separated by spaces and output
For Each strValue In arrValues
WScript.Echo strValue
Next
Else
Wscript.Echo "GetMultiStringValue failed. Error = " & Err.Number
End If

Recursive search of HKU registry hive for a DWORD value

I need help with a VBScript that will recursively search the Windows HKU registry hive for a DWORD value. It would be helpful if the script could ignore the system accounts only looking in the S-1-5-21* keys. I MUST accomplish this using the HKU hive and not the HKCU hive because the program I plan to use to run the script runs in the context of system. No way around that.
Thank you.
Const HKCU = &H80000001
Const HKLM = &H80000002
Const HKU = &H80000003
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
'Read the HKEY_CURRENT_USER hive, registry path, and valuename to retrieve settings
strKeyPath = "Software\Policies\Microsoft\Windows\System\Power"
strValueName = "PromptPasswordOnResume"
oReg.GetDWORDValue HKCU,strKeyPath,strValueName,dwValue
'Return a failure exit code if entry does not exist
If IsNull(dwValue) Then
Wscript.Echo "The value is either Null or could not be found in the registry."
WScript.Quit 1
'Return a failure exit code if value does not equal STIG setting
ElseIf dwValue <> 1 Then
Wscript.Echo "This is a finding. ", strValueName,"=", dwValue
WScript.Quit 1
'Return a passing exit code if value matches STIG setting
ElseIf dwValue = 1 Then
Wscript.Echo "This is not a finding. "
WScript.Quit 0
End If
All this is what I ultimately came up with to resolve my issue.
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
'Set the local computer as the target
strComputer = "."
'set the objRegistry Object
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
'Enumerate All subkeys in HKEY_USERS
objRegistry.EnumKey HKEY_USERS, "", arrSubkeys
'Define variables
strKeyPath = "\Software\Microsoft\Windows\CurrentVersion\Policies\Attachments"
strValueName = "HideZoneInfoOnProperties"
strSID = "S-1-5-21-\d*-\d*-\d*-\d{4,5}\\"
strValue = 1
f = True
For Each i in arrSubKeys
Set objRegExp = New RegExp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = strSID
Set colMatches = objRegExp.Execute(i + strKeyPath)
For Each objMatch In colMatches
objRegistry.GetDWORDValue HKEY_USERS,i + strKeyPath,strValueName,dwValue
If IsNull(dwValue) Then
WScript.Echo "This is a finding, the key " & i + strKeyPath & "\" & strValueName & " does not exist."
f = False
ElseIf dwValue <> strValue Then
WScript.Echo "This is a finding, the " & i + strKeyPath & "\" & strValueName & ": " & dwValue & " does not equal REG_DWORD = " & strValue & "."
f = False
ElseIf dwValue = strValue Then
WScript.Echo "This is not a finding " & i + strKeyPath & "\" & strValueName & " = " & dwValue
End If
Next
Next
If f Then
WScript.Quit 0
Else
WScript.Quit 1
End If
You don't need recursion here. Simply iterate over the subkeys of HKEY_USERS and (try to) read the value. The return code of GetDWORDValue() will indicate whether or not the value could be read.
Const HKEY_USERS = &h80000003
subkey = "Software\Policies\Microsoft\Windows\System\Power"
name = "PromptPasswordOnResume"
computer = "."
Set reg = GetObject("winmgmts://" & computer & "/root/default:StdRegProv")
reg.EnumKey HKEY_USERS, "", sidList
For Each sid In sidList
key = sid & "\" & subkey
rc = reg.GetDWORDValue(HKEY_USERS, key, name, val)
If rc = 0 Then
If val = 1 Then
WScript.Echo "OK"
WScript.Quit 0
Else
WScript.Echo "Not OK"
WScript.Quit 1
End If
End If
Next
I am not sure if i got you right. If it is that you want to search in the HKU not in the HKCU, then the point is that an account in HKU is mapped to HKCU. Like in your case S-1-5-21* will be mapped to HKCU. You can check it by modifying an entry in HKCU and that will be reflected in HKU(S-1-5-21*) and vice-a-versa.

Checking and opening different browsers using wsh script

hey guys i know this may sound stupid, but i am stuck with this question in my head...im really new to this wscript or vbscripting....at the time of writing i figured out how to open IE using wscript...heres the code
Set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run("iexplore.exe www.bbc.co.uk", 1)
but i cant figure out how to check if firefox is installed, then open firefox, if chrome is installed, open chrome, and the same thing goes for all the browser types.....
Update:
I did a little research and thought why not check the registry for that, so i came up with this script for checking the registry, now i dont know why but this always gives the same output "key does not exists" event though i have this registry in my system
keyTest = keyExists("HKEY_LOCAL_MACHINE\SOFTWARE\Mozilla\Mozilla Firefox")
If keyTest = False Then
wscript.echo "Key does not exist"
Elseif keyTest = True then
wscript.echo "Key exists"
End if
Function keyExists (RegistryKey)
If (Right(RegistryKey, 1) <> "\") Then
RegistryKeyExists = false
Else
On Error Resume Next
WshShell.RegRead RegistryKey
Select Case Err
Case 0:
keyExists = true
Case &h80070002:
ErrDescription = Replace(Err.description, RegistryKey, "")
Err.clear
WshShell.RegRead "HKEY_ERROR\"
If (ErrDescription <> Replace(Err.description, _
"HKEY_ERROR\", "")) Then
keyExists = true
Else
RegistryKeyExists = false
End If
Case Else:
keyExists = false
End Select
On Error Goto 0
End If
End Function
Problems in your example:
In keyExists(), a variable named RegistryKeyExists is being used for the return value from the function when keyExists is intended.
The Shell object variable WshShell is never instantiated via CreateObject().
The value of the registry key of interest does not end with a backslash.
Here's my streamlined version of your code which I believe accomplishes your objective:
Option Explicit ' programming with your seatbelt on :-)
Dim keys(4)
keys(0) = "HKEY_LOCAL_MACHINE\SOFTWARE\Mozilla\Mozilla Firefox"
keys(1) = "HKEY_LOCAL_MACHINE\SOFTWARE\Mozilla\Mozilla Firefox\"
keys(2) = "HKEY_LOCAL_MACHINE\Bad\Key\"
keys(3) = "BAD\Root\On\This\Key\Causes\Exception"
keys(4) = "HKLM\SOFTWARE\Microsoft\Internet Explorer\"
On Error Resume Next
Dim i, key
For i = 0 To UBound(keys)
key = keyExists(keys(i))
If Err Then
WScript.Echo "An exception occurred reading registry key" _
& " '" & keys(i) & "':" _
& " [" & Err.Number & "] " _
& Err.Description _
& ""
Else
If keyExists(keys(i)) Then
WScript.Echo "Key *exists*: [" & keys(i) & "]"
Else
WScript.Echo "Key does *not* exist: [" & keys(i) & "]"
End If
End If
WScript.Echo "--"
Next
Function keyExists (RegistryKey)
Dim keyVal, errNum, errDesc
keyExists = False
On Error Resume Next
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
keyVal = WshShell.RegRead(RegistryKey)
Select Case Err
Case 0
keyExists = True
Case &h80070002
' key does not exist
Case Else
errNum = Err.Number
errDesc = Err.Description
On Error GoTo 0
Err.Raise vbObjectError + 1, "WScript.Shell", _
"Something went wrong reading the registry:" _
& " [" & Hex(errNum) & "] " & errDesc
End Select
On Error GoTo 0
Set WshShell = Nothing
End Function
' End
Generally following code can be used to find out to get List of All Installed Software.
Here I have used Message box to display this list, you can use if condition to find out desired software is installed or not............
' List All Installed Software
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
Set objReg = GetObject("winmgmts://" & strComputer & _
"/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
For Each strSubkey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
strEntry1a, strValue1)
If strValue1 <> "" Then
MsgBox VbCrLf & "Display Name: " & strValue1
End If
Next
I have tried this code on machine & found that,it just listing Firefox browser, even when i have installed chrome & IE.So this regular method wont work surely for everyone. After that I have checked registry and found that,all browser are listed on.....
HKEY_LOCAL_MACHINE\SOFTWARE\Clients\StartMenuInternet\
So we can write code to find is is particular browser is installed or not.
Following sample code to check if Chrome & Firefox is installed or not and if installed open it with URL passed
Set WshShell = CreateObject("WScript.Shell")
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Clients\StartMenuInternet\chrome.exe\shell\open\command\"
strValueName = ""
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
If InStr(1,strValue,"chrome",vbTextCompare) Then WshShell.Run("chrome www.google.com")
strKeyPath = "SOFTWARE\Clients\StartMenuInternet\FIREFOX.EXE\shell\open\command\"
strValueName = ""
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
If InStr(1,strValue,"firefox",vbTextCompare) Then WshShell.Run("firefox www.google.com")
Similarly you can modify this code for IE, Opera & Safari
Hope this helps.......

Get Hex value of a Registry Key via VBScirpt

Think this is my target key in registry:
[HKEY_CURRENT_USER\System\Majid\0]
"GUID"=hex:60,de,2a,56,51,b2,e0,11,80,01,44,45,53,54,00,00
as you can see GUID has a hex value, I want to tell a vb-script to go to this key and stores its hex data into a variable.
For example if target variable is "Target" then its value should be "60,de,2a,56,51,b2,e0,11,80,01,44,45,53,54,00,00"
Any Help is Really Appreciated
It's likely that the reason you don't yet have an answer is that the premise of your question is misleading if not flawed. The question seems to imply you're asking about a hex number but you're actually asking about binary data. When you export a binary value from the registry the resulting .reg file encodes the value in hex as per your example. You may or may not have realized this, but it's likely been a stumbling block to solving your issue.
So now to answer "How can I convert a binary value to a hex string representation?"
The following code did the job for me. I only use vbscript on occasion so forgive the sloppiness.
Dim objRegistry, target, output
Set objRegistry = CreateObject("Wscript.shell")
target = objRegistry.RegRead("HKCU\System\Majid\0\GUID")
output = ""
for k = LBound(target,1) To UBound(target,1)
output = output & hex(target(k)) & ","
next
WScript.echo output
Does that work for you?
Wrote these today. I still need to figure out where the ",\" is placed in the code, but this one will take a REG_MULTI_SZ value and convert it to the proper hex result as seen in a .reg file.
'##### READ A REG_MULTI_SZ VALUE CONVERT TO HEX #####
strComputer = "."
Dim fso
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Dim oShell
Set oShell = WScript.CreateObject("Wscript.Shell")
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
regHive = "HKLM"
regKey = "Software\template\templateL2"
regValueName = "SAMPLE-Multi_String"
regPath = regHive & "\" & regKey & "\" & regValueName
regValue = oShell.RegRead(regPath)
res = ""
prefix = "hex(7):"
For Each item In regValue
data = data & item & vbcrlf
For i=1 To Len(item)
r = HexIt(Mid(item,i,1))
res = res & r
Next
res = res & "00,00," 'NEW LINE / ENTRY
Next
res = res & "00,00" 'FINAL COMPLETION
'CONVERT EACH CHARACTER TO ASCII THEN TO HEX, ADD ",00," BETWEEN EACH VALUE
Function HexIt(data)
a = Asc(data)
h = Hex(a)
HexIt = h & ",00,"
End Function
WScript.Echo "ACTUAL DATA IN GUI : " & vbCrLf & data & vbCrLf
WScript.Echo "HEX REPRESENTATION : " & vbCrLf & res & vbCrLf
WScript.Echo "REG FILE VALUE : " & vbCrLf & prefix & res & vbCrLf
One for REG_EXPAND_SZ
'############# READ REG_EXPAND_SZ ##########
strComputer = "."
Dim fso
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Dim oShell
Set oShell = WScript.CreateObject("Wscript.Shell")
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
regHive = "HKLM"
regKey = "Software\template\templateL2"
regValueName = "Expandable_String"
regPath = regHive & "\" & regKey & "\" & regValueName
regValue = oShell.RegRead(regPath)
res = ""
prefix = "hex(2):"
For i=1 To Len(regValue)
r = HexIt(Mid(regValue,i,1))
res = res & r
Next
res = res & "00,00" 'NEW LINE / ENTRY
WScript.Echo "INPUT DATA IN GUI : " & regValue
WScript.Echo "HEX REPRESENTATION: " & res
WScript.Echo "REG FILE VALUE : " & prefix & res
'CONVERT EACH CHARACTER TO ASCII THEN TO HEX, ADD ",00," BETWEEN EACH VALUE
Function HexIt(data)
a = Asc(data)
h = Hex(a)
HexIt = h & ",00,"
End Function
Here is one for DWORD
'##### READ A DWORD VALUE CONVERT TO HEX #####
strComputer = "."
Dim fso
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Dim oShell
Set oShell = WScript.CreateObject("Wscript.Shell")
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
regHive = "HKLM"
regKey = "Software\template\templateL2"
regValueName = "SAMPLE-Dword"
regPath = regHive & "\" & regKey & "\" & regValueName
regValue = oShell.RegRead(regPath) 'SPECIFY YOUR HIVE\KEY\VALUE HERE
res = ""
If Len(regvalue) Mod 2 = 0 Then
res = "0x"
leading0 = ""
Else
res = "0x0"
leading0 = "0"
End If
WScript.Echo "INPUT DATA IN GUI : " & Hex(regValue)
WScript.Echo "HEX REPRESENTATION: " & res & Hex(regvalue)
WScript.Echo "REG FILE VALUE : " & "dword:" & leading0 & Hex(regvalue)

Resources