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
Related
I've been trying to use VBScript to change a DWORD Value in HKEY_USERS. It can find the value and tell me what it is, but it will not change the value.
Const HKEY_USERS = &H80000003
strComputer = "."
Set oReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = ".DEFAULT\Software\Microsoft\Office\Outlook\Addins\Flowscape.Outlook.AddIn"
strValueName = "LoadBehavior"
oReg.SetDWORDValue HKEY_USERS, strKeyPath, strValueName, 3
If Err = 0 Then
oReg.GetDWORDValue HKEY_USERS, strKeyPath, strValueName, dwValue
WScript.Echo "HKEY_USERS\...\LoadBehavior is set to " & dwValue
Else
WScript.Echo "Error changing dword value" & Err.Number
End If
This other script for changing DWORD Value in HKEY_CURRENT_USER works fine.
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Office\Outlook\Addins\Flowscape.Outlook.AddIn"
strValueName = "LoadBehavior"
oReg.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, 3
If Err = 0 Then
oReg.GetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, dwValue
WScript.Echo "HKEY_CURRENT_USER\...\LoadBehavior set to " & dwValue
Else
WScript.Echo "Error changing dword value" & Err.Number
End If
I was trying to read the Uninstall Keys (DisplayName, Display Version, Vendor ..) from both 32 and 64 Bit installation keys. I have below code but it is always giving only 32 bit keys info. As I wrote the below code it is giving the entries from 32 bit twice :(
' Constants (taken from WinReg.h)
'
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
' Chose computer name, registry tree and key path
'
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
ObjExcel.Cells (1,1) = "Application Name"
ObjExcel.Cells (1,4) = "Application Vendor"
ObjExcel.Cells (1,2) = "Application Version"
ObjExcel.Cells (1,3) = "DRM Build"
strComputer = InputBox("Enter the Machine name. To run on the current machine, press ENTER", "Machine Name", "")
If strComputer = "" Then
strComputer = "."
End If
Msgbox "Script is Running and may take couple of minutes to complete. Click on OK to continue",0, "Information"
hDefKey = HKEY_LOCAL_MACHINE
' Connect to registry provider on target machine with current user
Set oReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
'{impersonationLevel=impersonate}!
' Enum the subkeys of the key path we've chosen
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
row = 2
getRegistryEntries hDefKey, strKeyPath, ObjExcel, oReg, row
strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
getRegistryEntries hDefKey, strKeyPath, ObjExcel, oReg, row
fileName = Year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now)
ObjExcel.ActiveWorkbook.SaveAs "C:\" & fileName & ".xlsx"
ObjExcel.Quit
Set ObjExcel = Nothing
msgbox "Work Done, file saved in C Drive with the name: " & fileName
Function getRegistryEntries(hDefKey, strKeyPath, byRef objExcel, byRef oReg, byRef row)
oReg.EnumKey hDefKey, strKeyPath, arrSubKeys
Set objShell = CreateObject("WScript.Shell")
For Each strSubkey In arrSubKeys
' Show the subkey
'
furtherKeys = False
strDisName = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\DisplayName"
On Error Resume Next
present = False
disName = objShell.RegRead(strDisName)
If disName <> "" Then
present = True
End If
disVersionPresent = false
disVer = ""
If present = true Then
strDisVer = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\DisplayVersion"
strDisVendor = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\Publisher"
strDRMBuild = "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & strSubkey & "\DRMBUILD"
disVer = objShell.RegRead(strDisVer)
If err.number = 0 Then
disVersionPresent = True
End If
If disVersionPresent Then
ObjExcel.Cells (row,1) = disName
ObjExcel.Cells (row,2) = "'" & disVer
furtherKeys = True
disVendor = objShell.RegRead(strDisVendor)
If err.number = 0 Then
ObjExcel.Cells (row,4) = disVendor
End If
DRMBuild = objShell.RegRead(strDRMBuild)
If err.number = 0 Then
ObjExcel.Cells (row,3) = "'" & DRMBuild
End If
End If
End If
If furtherKeys Then
row = row + 1
End If
Next
End Function
I am looking for a way to have my current VBScript (it is very big and I don't know if there is a way to pair it down) that currently creates a list of all computers in active directory and outputs it to a file. Once that is completed the rest of my script then calls that text file and creates another one with all the computer names and date/time/ and what the teamviewer ID is by means of either Windows 7 reg key or Windows XP. The issue I am running into is that if a computer doesn't exist in the domain anymore the script places the previous value into the computer that doesn't exist which is creating duplicates.
I would love to find a way to edit my script and ping each of the computers in the original text file and remove the computers out of it that are not online. I will attach my script. Let me know if you have any questions.
' Declare the constants
Dim oFSO
Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
'Const REG_SZ = 1 ' String value in registry (Not DWORD)
Const ForReading = 1
Const ForWriting = 2
' Set File objects...
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objDictionary2 = CreateObject("Scripting.Dictionary")
' Set string variables
strDomain = "my domain" ' Your Domain
strPCsFile = "DomainPCs.txt"
strPath = "C:\logs\" ' Create this folder
strWorkstationID = "C:\logs\WorkstationID.txt"
If objFSO.FolderExists(strPath) Then
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
Else
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
oFSO.CreateFolder strPath
End If
' Get list of domain PCs - Using above variables.
strMbox = MsgBox("Would you like info for entire domain: rvdocs.local?",3,"Hostname")
'an answer of yes will return a value of 6, causing script to collect domain PC info
If strMbox = 6 Then
Set objPCTXTFile = objFSO.OpenTextFile(strPath & strPCsFile, ForWriting, True)
Set objDomain = GetObject("WinNT://" & strDomain) ' Note LDAP does not work
objDomain.Filter = Array("Computer")
For Each pcObject In objDomain
objPCTXTFile.WriteLine pcObject.Name
Next
objPCTXTFile.close
Else
'an answer of no will prompt user to input name of computer to scan and create PC file
strHost = InputBox("Enter the computer you wish to get Workstation ID","Hostname"," ")
Set strFile = objfso.CreateTextFile(strPath & strPCsFile, True)
strFile.WriteLine(strHost)
strFile.Close
End If
' Read list of computers from strPCsFile into objDictionary
Set readPCFile = objFSO.OpenTextFile(strPath & strPCsFile, ForReading)
i = 0
Do Until readPCFile.AtEndOfStream
strNextLine = readPCFile.Readline
objDictionary.Add i, strNextLine
i = i + 1
Loop
readPCFile.Close
' Build up the filename found in the strPath
strFileName = "Workstation ID_" _
& year(date()) & right("0" & month(date()),2) _
& right("0" & day(date()),2) &".txt"
' Write each PC's software info file...
Set objTextFile2 = objFSO.OpenTextFile(strPath & strFileName, ForWriting, True)
For each DomainPC in objDictionary
strComputer = objDictionary.Item(DomainPC)
On error resume next
' WMI connection to the operating system note StdRegProv
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' These paths are used in the filenames you see in the strPath
pcName = "SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\"
pcNameValueName = "ComputerName"
objReg.GetStringValue HKLM,pcName,pcNameValueName,pcValue
strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath, strValueName, strValue
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strValue = " No Teamviewer ID"
End If
Set objReg = Nothing
Set ObjFileSystem = Nothing
objTextFile2.WriteLine(vbCRLF & "==============================" & vbCRLF & _
"Current Workstation ID: " & UCASE(strComputer) & vbCRLF & Time & vbCRLF & Date _
& vbCRLF & "Teamviewer ID:" & "" & strValue & vbCRLF & "----------------------------------------" & vbCRLF)
'GetWorkstationID()
Next
WScript.echo "Finished Scanning Network check : " & strPath
objFSO.DeleteFile(strPath & strPCsFile)
wscript.Quit
The cause of the issue is that objReg retains its value from the previous iteration when
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
fails due to a non-reachable computer (which is masked by On Error Resume Next).
One way to deal with the issue is to set objReg to Nothing before trying to connect to the remote host and check if the variable still is Nothing afterwards:
On Error Resume Next
Set objReg = Nothing
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If Not objReg Is Nothing Then
'check for TeamViewer ID
Else
'remote host unavailable
End If
A more elegant solution to the problem (one that doesn't require the infamous On Error Resume Next) is to ping the remote computer before trying to connect to it:
Set wmi = GetObject("winmgmts://./root/cimv2")
qry = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
For Each response In wmi.ExecQuery(qry)
If IsObject(response) Then
hostAvailable = (response.StatusCode = 0)
Else
hostAvailable = False
End If
Next
If hostAvailable Then
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
'check for TeamViewer ID
Else
'remote host unavailable
End If
Here is what I came up with. I had to add the "On Error Resume Next" otherwise it would bring up an error box. Here is the code with the modified piece:
' Declare the constants
Dim oFSO
Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
'Const REG_SZ = 1 ' String value in registry (Not DWORD)
Const ForReading = 1
Const ForWriting = 2
' Set File objects...
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objDictionary2 = CreateObject("Scripting.Dictionary")
' Set string variables
strDomain = "mydomain" ' Your Domain
strPCsFile = "DomainPCs.txt"
strPath = "C:\logs\" ' Create this folder
strWorkstationID = "C:\logs\WorkstationID.txt"
If objFSO.FolderExists(strPath) Then
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
Else
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
oFSO.CreateFolder strPath
End If
' Get list of domain PCs - Using above variables.
strMbox = MsgBox("Would you like info for entire domain: rvdocs.local?",3,"Hostname")
'an answer of yes will return a value of 6, causing script to collect domain PC info
If strMbox = 6 Then
Set objPCTXTFile = objFSO.OpenTextFile(strPath & strPCsFile, ForWriting, True)
Set objDomain = GetObject("WinNT://" & strDomain) ' Note LDAP does not work
objDomain.Filter = Array("Computer")
For Each pcObject In objDomain
objPCTXTFile.WriteLine pcObject.Name
Next
objPCTXTFile.close
Else
'an answer of no will prompt user to input name of computer to scan and create PC file
strHost = InputBox("Enter the computer you wish to get Workstation ID","Hostname"," ")
Set strFile = objfso.CreateTextFile(strPath & strPCsFile, True)
strFile.WriteLine(strHost)
strFile.Close
End If
' Read list of computers from strPCsFile into objDictionary
Set readPCFile = objFSO.OpenTextFile(strPath & strPCsFile, ForReading)
i = 0
Do Until readPCFile.AtEndOfStream
strNextLine = readPCFile.Readline
objDictionary.Add i, strNextLine
i = i + 1
Loop
readPCFile.Close
' Build up the filename found in the strPath
strFileName = "Workstation ID_" _
& year(date()) & right("0" & month(date()),2) _
& right("0" & day(date()),2) & ".txt"
' Write each PC's software info file...
Set objTextFile2 = objFSO.OpenTextFile(strPath & strFileName, ForWriting, True)
For each DomainPC in objDictionary
strComputer = objDictionary.Item(DomainPC)
Set wmi = GetObject("winmgmts://./root/cimv2")
qry = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
For Each response In wmi.ExecQuery(qry)
If IsObject(response) Then
hostAvailable = (response.StatusCode = 0)
Else
hostAvailable = False
End If
Next
On error resume Next
If hostAvailable Then
'check for TeamViewer ID
' WMI connection to the operating system note StdRegProv
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' These paths are used in the filenames you see in the strPath
pcName = "SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\"
pcNameValueName = "ComputerName"
objReg.GetStringValue HKLM,pcName,pcNameValueName,pcValue
strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath, strValueName, strValue
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\TeamViewer\Version5\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strValue = " No Teamviewer ID"
End If
Set objReg = Nothing
Set ObjFileSystem = Nothing
objTextFile2.WriteLine(vbCRLF & "==============================" & vbCRLF & _
"Current Workstation ID: " & UCASE(strComputer) & vbCRLF & Time & vbCRLF & Date _
& vbCRLF & "Teamviewer ID:" & "" & strValue & vbCRLF _
& "----------------------------------------" & vbCRLF)
'GetWorkstationID()
strValue = NULL
Else
'remote host unavailable
End If
Next
WScript.echo "Finished Scanning Network check : " & strPath
'objFSO.DeleteFile(strWorkstationID)
objFSO.DeleteFile(strPath & strPCsFile)
wscript.Quit
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.
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)