For a Test automation I have to check if certain Keys are generated in the registry.
By far I have this script:
'Registry Path
Const HKCR = &H80000000 'HKEY_CLASSES_ROOT (0)
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE (1)
Dim oReg: Set oReg = GetObject("winmgmts:!root/default:StdRegProv")
'Dim Arrays
Dim RegRootArray(1)
Dim RegMachineArray(6)
Dim CurrentArray()
'HKEY_CLASSES_ROOT Array
RegRootArray(0) = "AlmBtPgLib.ALMPlugIn.1\CLSID"
RegRootArray(1) = "AlmBtPgLib.ALMPlugIn\CurVer"
'HKEY_LOCAL_MACHINE Array
RegMachineArray(0) = "SOFTWARE\Macrovision\FlexNet Publisher"
RegMachineArray(1) = "SOFTWARE\Company\SWS\PlugIns\AlmBtPgLib.ALMPlugIn"
RegMachineArray(2) = "SYSTEM\ControlSet001\services\FlexNet Licensing Service"
RegMachineArray(3) = "SYSTEM\CurrentControlSet\services\FlexNet Licensing Service"
RegMachineArray(4) = "SOFTWARE\Company\LMS"
RegMachineArray(5) = "SYSTEM\CurrentControlSet\services\aksfridge"
RegMachineArray(6) = "SYSTEM\CurrentControlSet\services\hasplms"
'Loop through both Arrays and check Registry
For i = 0 To 1
If i=0 Then
ReDim CurrentArray(UBound(RegRootArray)) 'Copy Values from RegRootArray to CurrentArray
For arrI1 = LBound(RegRootArray) To UBound(RegRootArray)
CurrentArray(arrI1) = RegRootArray(arrI1)
Next
Key = HKCR
Else
ReDim CurrentArray(UBound(RegMachineArray)) 'Copy Values from RegMachineArray to CurrentArray
For arrI2 = LBound(RegMachineArray) To UBound(RegMachineArray)
CurrentArray(arrI2) = RegMachineArray(arrI2)
Next
Key = HKLM
End If
'Check Keys in Registry
For Each Path In CurrentArray
If oReg.EnumKey(Key, Path, arrSubKeys) = 0 Then
MsgBox(Path & " exist") 'for development
Else
MsgBox(Path & " don't exist") 'for development
End If
Next
Next
For some reason
"SOFTWARE\Company\SWS\PlugIns\AlmBtPgLib.ALMPlugIn"
is shown as non existing.
I checked if PlugIns or SWS "exists".
None of them do. Company does exist.
I checked the registry and the path manually. Both seem to be okay.
When I create a new Key I can't find it neither.
I restarted the system, no change.
The return value of EnumKey is 2. Simply 2.
I searched the web but couldn't find a solution.
Thanks for your help.
I can't check anything util tomorrow because i leave work for the day.
Update:
When i run the script extern, say as checkReg.vbs it works.
Could it be that UFT somehow has not the right permission? Although both, the .vbs script and UFT run under the same User.
Cheers
sam
In scripting or Visual Basic, the method EnumKey returns an integer value that is 0 (zero) if successful. If the function fails, the return value is a nonzero error code according to Microsoft.
http://msdn.microsoft.com/en-us/library/aa390387%28v=vs.85%29.aspx
Should not you use something like this instead:
Set objReg = Server.CreateObject("WScript.Shell")
RegValue = objReg.RegRead(yourregistryentrypath)
Related
Code is cleaned and changed from previous post since old logics had various errors that have been corrected and narrowed down to one error in one condition that I cant find an answer to. Currently getting error when my url is being read as only value and throwing Subscript Out of range error even though array is initialized. Other conditions when user has preset items or no key at all works perfectly. Thanks.
option explicit
'on error resume next
Dim ObjName,oADSysInfo,strComputer
Dim objReg,IE_Main,mstrValName,strFunctionIntranet,strNYHomepage,multiStringValues(),allURLs(),itemname,a,return
Set oADSysInfo = CreateObject("ADSystemInfo")
Set ObjName = GetObject("LDAP://" & oADSysInfo.UserName)
strComputer = "."
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
Const HKCU = &H80000001
IE_Main = "Software\Microsoft\Internet Explorer\Main"
mstrValName = "Secondary Start Pages"
strNYHomepage = "http://www.google.com"
strFunctionIntranet = "www.mycompany.com"
SetHomePage
Sub SetHomepage
objReg.setStringValue HKCU,IE_Main,"Start Page",strNYHomepage
'Reading MultiStringValue of "Secondary Start Pages" for HKCU and continuing if it has something preset.
return = objReg.getMultiStringValue (HKCU,IE_Main,mstrValName,multiStringValues)
If return=0 Then
a=0
'Reading all items currently set to make sure users retain their existing URLs.
For Each itemname In multiStringValues
'Only continue if any of the existing URLs DO NOT MATCH what we are enforcing as the URL.
If itemname <> strFunctionIntranet Then
WScript.Echo itemname
WScript.Echo "itemname is NOT equal intranet"
a = a + 1
ReDim Preserve allURLs(a)
allURLs(a) = itemname
'a = a + 1
End If
Next
objReg.DeleteValue HKCU,IE_Main,mstrValName
'Enforce our URL to always be the first item.
allURLs(0)=strFunctionIntranet
'Set the new MultiStringValue registry key back.
objReg.setMultiStringValue HKCU,IE_Main,mstrValName,allURLs
WScript.echo "finished setting all secondary tabs... "
Else
strFunctionIntranet = Array(strFunctionIntranet)
objReg.setMultiStringValue HKCU,IE_Main,mstrValName,strFunctionIntranet
End If
End Sub
Wscript.Quit
Your array contains an empty element, because you create it one field too big.
Change this line:
ReDim Preserve allURLs(a+1)
into this:
ReDim Preserve allURLs(a)
What I want is for this program to do is to show Microsoft Outlook 2010 in "installed" listbox if it's installed and "notinstalled" if it's not installed. "listbox1" has a list of all installed applications in it on form load.
The issue is that while it does work for the "installed" portion, it lists the application many times in the "notinstalled" box. I only want it to show up once.
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim regkey, subkey As Microsoft.Win32.RegistryKey
Dim value As String
Dim regpath As String = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
regkey = My.Computer.Registry.LocalMachine.OpenSubKey(regpath)
Dim subkeys() As String = regkey.GetSubKeyNames
Dim includes As Boolean
For Each subk As String In subkeys
subkey = regkey.OpenSubKey(subk)
value = subkey.GetValue("DisplayName", "")
If value <> "" Then
includes = True
If value.IndexOf("Hotfix") <> -1 Then includes = False
If value.IndexOf("Security Update") <> -1 Then includes = False
If value.IndexOf("Update for") <> -1 Then includes = False
If includes = True Then ListBox1.Items.Add(value)
End If
Next
Dim count As Integer = (ListBox1.Items.Count - 1)
Dim words As String
Dim softName As String
softName = "Microsoft Outlook 2010"
For a = 0 To count
words = ListBox1.Items.Item(a)
If InStr(words.ToLower, softName.ToLower) Then
Installed.Items.Add(words)
Else
NotInstalled.Items.Add(softName)
End If
Next
I think you should try something like. (I'm a c# guy, so I hope my syntax is right.)
Dim isOutlookInstalled = False
softName = "Microsoft Outlook 2010"
For a = 0 To count
words = ListBox1.Items.Item(a)
If InStr(words.ToLower, softName.ToLower) Then
Installed.Items.Add(words)
End If
Next
If isOutlookInstalled <> True
NotInstalled.Items.Add(softName)
End If
The repeating string is due to a simple error due to the call to NotInstalled.Items.Add(softName) for each item inspected. You probably want to add it only at the end of the loop.
However you could simplify your code with a bit of Linq
Dim result = words.Where(Function(x) x.ToLower().IndexOf("microsoft outlook 2010") >= 0)
if result IsNot Nothing then
Installed.Items.AddRange(result.ToArray)
else
NotInstalled.Items.Add(softName)
end if
But you should consider some problems in your code. If Outlook is installed as part of Office there is not an entry for it in the uninstall section. Then there is the problem of the automatic redirection to different section of the registry if you are running on a 64bit system. And what if your Outlook is a 32bit version installed on a 64bit system and your app run in AnyCPU mode? It is not a trivial task to account for all these possibility. Just to warn you
I must have a vbs script which can delete the string ",vmhgfs" (the coma is important) if it exists in the a registry data.
The registry key is:
"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\NetworkProvider\Order"
The registry value is "ProviderOrder" (it's a string value)
The data is something like "PICAClientNetwork,SnacNp,vmhgfs,RDPNP,LanmanWorkstation,webclient,PnSson" but can be very different from a computer to another.
The script must check if the string ",vmhgfs" exists in this data, and if it exists, delete it. If it don't exist, just end.
I'm newbie in VBS, and I've begun to write this script:
Dim objShell, RegValue, RegData
RegValue = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\NetworkProvider\Order\ProviderOrder"
set objShell = CreateObject("Wscript.Shell")
RegData = objShell.RegRead(RegKey)
wscript.echo RegData
The returned echo show me i'm in the right way... but not enough skill to go further...
Can you please help me by finishing it ! Many thanks in advance !
EDIT (before applying your advices):
Hi, thanks guys so I've written the script:
Dim objShell, RegValue, RegData, NewRegData
RegValue = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\NetworkProvider\Order\ProviderOrder"
set objShell = CreateObject("Wscript.Shell")
RegData = objShell.RegRead(RegValue)
if Instr(RegData,",vmhgfs") > 0 then
NewRegData = Replace(RegData,",vmhgfs", "")
objshell.Regwrite RegValue ,NewRegData
Else IF Instr(RegData,"vmhgfs") > 0 then
NewRegData2 = Replace(RegData,"vmhgfs,", "")
objshell.Regwrite RegValue ,NewRegData2
End If
set objshell = nothing
The first "IF" is to manage the case where ",vmhgfs" is in the middle of the string. OK The second "IF" is to manage the case where "vmhgfs" is at the beginning of the string
BUT THIS DOESN'T WORK IF ",vmhgfs" IS AT THE VERY END OF THE STRING !!!
I don't undestand that, please help !
How about this?
if InStr(1,RegData,",vmhgfs") > 0 then
NewRegData = left(RegData,InStr(1,RegData,",vmhgfs")) & right(RegData,7+InStr(1,RegData,",vmhgfs"))
or (as per Ansgar :) )
if InStr(1,RegData,",vmhgfs") > 0 then
newRegData = Replace(RegData, ",vmhgfs", "")
Then you just have to write it back to the registry
I'd use a regular expression instead of InStr here, because the latter would also (mis)detect things like ,vmhgfsFOOBAR.
Set sh = CreateObject("Wscript.Shell")
Set re = New RegExp
re.Global = True
val = "HKLM\SYSTEM\CurrentControlSet\Control\NetworkProvider\Order\ProviderOrder"
re.Pattern = "(^|,)vmhgfs(,|$)"
data = re.Replace(sh.RegRead(val), ",")
re.Pattern = "^,|,$"
sh.RegWrite val, re.Replace(data, ""), "REG_SZ"
I thought this would be easy, but apparently nobody does it...
I'm trying to see if a registry key exists. I don't care if there are any values inside of it such as (Default).
This is what I've been trying.
Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
objRegistry.GetStringValue &H80000003,".DEFAULT\Network","",regValue
If IsEmpty(regValue) Then
Wscript.Echo "The registry key does not exist."
Else
Wscript.Echo "The registry key exists."
End If
I only want to know if HKEY_USERES\.DEFAULT\.Network exists. Anything I find when searching mostly seems to discuss manipulating them and pretty much assumes the key does exists since it's magically created if it doesn't.
I found the solution.
dim bExists
ssig="Unable to open registry key"
set wshShell= Wscript.CreateObject("WScript.Shell")
strKey = "HKEY_USERS\.Default\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Digest\"
on error resume next
present = WshShell.RegRead(strKey)
if err.number<>0 then
if right(strKey,1)="\" then 'strKey is a registry key
if instr(1,err.description,ssig,1)<>0 then
bExists=true
else
bExists=false
end if
else 'strKey is a registry valuename
bExists=false
end if
err.clear
else
bExists=true
end if
on error goto 0
if bExists=vbFalse then
wscript.echo strKey & " does not exist."
else
wscript.echo strKey & " exists."
end if
The second of the two methods here does what you're wanting. I've just used it (after finding no success in this thread) and it's worked for me.
http://yorch.org/2011/10/two-ways-to-check-if-a-registry-key-exists-using-vbscript/
The code:
Const HKCR = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Const HKUS = &H80000003 'HKEY_USERS
Const HKCC = &H80000005 'HKEY_CURRENT_CONFIG
Function KeyExists(Key, KeyPath)
Dim oReg: Set oReg = GetObject("winmgmts:!root/default:StdRegProv")
If oReg.EnumKey(Key, KeyPath, arrSubKeys) = 0 Then
KeyExists = True
Else
KeyExists = False
End If
End Function
Simplest way avoiding RegRead and error handling tricks. Optional friendly consts for the registry:
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
Then check with:
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
If oReg.EnumKey(HKEY_LOCAL_MACHINE, "SYSTEM\Example\Key\", "") = 0 Then
MsgBox "Key Exists"
Else
MsgBox "Key Not Found"
End If
IMPORTANT NOTES FOR THE ABOVE:
Equals zero means the key EXISTS.
The slash after key name is optional and not required.
In case anyone else runs into this, I took WhoIsRich's example and modified it a bit. When calling ReadReg I needed to do the following: ReadReg("App", "HKEY_CURRENT_USER\App\Version") which would then be able to read the version number from the registry, if it existed. I also am using HKCU since it does not require admin privileges to write to.
Function ReadReg(RegKey, RegPath)
Const HKEY_CURRENT_USER = &H80000001
Dim objRegistry, oReg
Set objRegistry = CreateObject("Wscript.shell")
Set oReg = GetObject("winmgmts:!root\default:StdRegProv")
if oReg.EnumKey(HKEY_CURRENT_USER, RegKey) = 0 Then
ReadReg = objRegistry.RegRead(RegPath)
else
ReadReg = ""
end if
End Function
edit (sorry I thought you wanted VBA).
Anytime you try to read a non-existent value from the registry, you get back a Null. Thus all you have to do is check for a Null value.
Use IsNull not IsEmpty.
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
strValueName = "Test Value"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
If IsNull(strValue) Then
Wscript.Echo "The registry key does not exist."
Else
Wscript.Echo "The registry key exists."
End If
See the Scripting Guy! Blog:
How Can I Tell Whether a Value Exists in the Registry?
They discuss doing the check on a remote computer and show that if you read a string value from the key, and if the value is Null (as opposed to Empty), the key does not exist.
With respect to using the RegRead method, if the term "key" refers to the path (or folder) where registry values are kept, and if the leaf items in that key are called "values", using WshShell.RegRead(strKey) to detect key existence (as opposed to value existance) consider the following (as observed on Windows XP):
If strKey name is not the name of an existing registry path, Err.Description reads "Invalid root in registry key"... with an Err.Number of 0x80070002.
If strKey names a registry path that exists but does not include a trailing "\" the RegRead method appears to interpret strKey as a path\value reference rather than as a simple path reference, and returns the same Err.Number but with an Err.Description of "Unable to open registry key". The term "key" in the error message appears to mean "value". This is the same result obtained when strKey references a path\value where the path exists, but the value does not exist.
The accepted answer is too long, other answers didn't work for me. I'm gonna leave this for future purpose.
Dim sKey, bFound
skey = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\SecurityHealth"
with CreateObject("WScript.Shell")
on error resume next ' turn off error trapping
sValue = .regread(sKey) ' read attempt
bFound = (err.number = 0) ' test for success
on error goto 0 ' restore error trapping
end with
If bFound Then
MsgBox = "Registry Key Exist."
Else
MsgBox = "Nope, it doesn't exist."
End If
Here's the list of the Registry Tree, choose your own base on your current task.
HKCR = HKEY_CLASSES_ROOT
HKCU = HKEY_CURRENT_USER
HKLM = HKEY_LOCAL_MACHINE
HKUS = HKEY_USERS
HKCC = HKEY_CURRENT_CONFIG
I want to change the Source file Server path location in the reg path
HKEY_CLASSES_ROOT\Installer\Products\Product GUID\SourceList\Net\1 of every client machines,
as we have removed the existing Application server with a new one...We were able to change the old server path to new server path using the "replace" function in vbscript.
Set objWS = CreateObject("WScript.Shell")
strKeyValue = objWS.RegRead("HKEY_CLASSES_ROOT\Installer\Products\A7C4EB2D0BDDF2A43BDD35A498E12655\SourceList\Net\1")
newstrKeyValue = Replace(strKeyValue,"\\INADCSRV11" ,"\\INADCSRV12")
newstrKeyValue2 = Replace (newstrKeyValue ,"SMSPKGC$" ,"SMSPKGP$")
Const HKEY_CLASSES_ROOT = &H80000000
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "Installer\Products\A7C4EB2D0BDDF2A43BDD35A498E12655\SourceList\Net\"
strValueName = "1"
strValue = newstrKeyValue2
oReg.SetExpandedStringValue HKEY_CLASSES_ROOT,strKeyPath,strValueName,strValue
but we are stuck in reading the reg values....
Product GUID is a variable.First we have to read till that path and then after reading one GUID, again we have to read the complete path
HKEY_CLASSES_ROOT\Installer\Products\Product GUID\SourceList\Net\1 and then change the server name
Please let me know anyone have encountered any situation like this.
Assuming I'm not mistaken and you want to enumerate all the subkeys within a certain key this this answer from another question shows code that does this.