Writing From HKEY_USERS - windows

I am attempting to create an application that will allow me to input a username and switch that user's default printer by modifying the registry under HKEY_USERS\UserSID. I cannot seem write values to that section of the registry though. Perhaps it's a Windows limitation? Here's the code I have so far.
Dim strComputer = "."
Dim objWMIService As Object = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Dim theUsername As String = TextBox1.Text
Dim theDomain As String = TextBox2.Text
Dim objAccount As Object = objWMIService.Get("Win32_UserAccount.Name='" & theUsername & "',Domain='" & theDomain & "'")
Dim theport As RegistryKey
theport = Registry.CurrentUser.OpenSubKey("Software\\Microsoft\\Windows NT\\CurrentVersion\\Devices")
Dim val As Object = theport.GetValue(ListBox1.SelectedItem)
theport.Close()
Dim theSid As String = objAccount.sid
Dim theKey As RegistryKey = Registry.Users.OpenSubKey(theSid + "\\Software\\Microsoft\\Windows NT\\CurrentVersion\\Windows", True)

I don't think that there is some Windows limitation, because I wrote to HKEY_USERS\SIDs many times. But I used for this purpose the vbscript. Also I should warn you that you can only read&write to Users registry if they are logged. For not logged users - use the ActiveSetup.
There is my script on vbs which writes some registry to all logged users. Hope you could adapt it to VB.NET.
Option Explicit
Const HKEY_USERS = &H80000003
Dim objReg, objWMI, colSessions, objSession, colList, colUsers, objUser, Domain, UserName, objUserAccount, SID, WshShell
Set WshShell = CreateObject("WScript.Shell")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colSessions = objWMI.ExecQuery("Select * from Win32_LogonSession Where LogonType = 2 Or LogonType = 10")
If colSessions.Count <> 0 Then
For Each objSession in colSessions
Set colUsers = objWMI.ExecQuery("Associators of " & "{Win32_LogonSession.LogonId=" & objSession.LogonId & "} " & "Where AssocClass=Win32_LoggedOnUser Role=Dependent" )
For Each objUser in colUsers
Domain = objUser.Domain : UserName = objUser.Name
Set objUserAccount = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_UserAccount.Domain='" & Domain & "',Name='" & UserName & "'")
SID = objUserAccount.SID
objReg.CreateKey HKEY_USERS, SID & "\Control Panel\Desktop"
objReg.SetStringValue HKEY_USERS, SID & "\Control Panel\Desktop", "Example", "1"
objReg.SetDwordValue HKEY_USERS, SID & "\Control Panel\Desktop", "Example", "2"
Next
Next
End If

Related

Pulling Registry Values not working

I have just started learning automation....
Am looking to query below registry values to a test file with a date.
eRegistry values
I have written below script; however, I think this is missing some logic hence not able to get append value for each registry string,
Const HKEY_LOCAL_MACHINE = &H80000002
Const ForAppending = 2
Set objfso = CreateObject("scripting.filesystemobject")
Set objFile = objfso.OpenTextFile("C:\SWSetup\abc.txt", 8, true)
'Set filestreamOUT = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt,8,true)
strComputer = "."
'strPath = "C:\SWSetup\abc.txt"
strKeyPath = "SOFTWARE\SAT"
strValueName1 = "Bcore"
strValueName = "GG"
strValueName = "Graph"
strValueName = "MEM"
strValueName = "PHD"
strValueName = "PHDk"
strValueName = "Pro"
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
'oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue,strValueName1
objFile.WriteLine (Now)
objfile.WriteLine strValue
objfile.Close
You can do it in a much simpler way.
Use WScript.Shell Object to read values from registry.
Created a sample for you.
Modify it accordingly
I tested on my system.
I am seeing the expected results.
'DECLARE A FILE SYSTEM OBJECT
Set objfso = CreateObject("scripting.filesystemobject")
Set objFile = objfso.OpenTextFile("C:\\Users\\<<YOUR USER NAME>>\\desktop\\abc.txt", 8, true)
'CREATE A SHELL OBJECT TO READ REGISTRY
Dim WSHShell, value
Set WSHShell = CreateObject("WScript.Shell")
'READ REGISTRY VARIABLES
value = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\SAT\GG")
objFile.WriteLine (value & " " & Now)
value = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\SAT\Graph")
objFile.WriteLine (value & " " & Now)
value = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\SAT\MEM")
objFile.WriteLine (value & " " & Now)
value = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\SAT\PHD")
objFile.WriteLine (value & " " & Now)
'CLEAR THE OBJECTS
objfile.Close
set WSHShell = nothing
To get the key name perfectly:
Run the registry and search for "SAT" in your case.
Select it and right click your mouse.
You can see "Copy Key Name".
Select it.
Now paste it in some notepad.
Then append the "value" names to it. ( in your case GG MEM etc..)

Vbscript to query computer name and then write to registry HKLM\software dword?

Hi could any one point me in the right direction to create Vbscript to query computer name and then write the query result to registry HKLM\software\test dword or string
this is what i have got so far i just dont know how to link the query then add the query result to the registry -thanks in advance
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName"
strValueName = "ComputerName"
oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath, _
strValueName,strValue
From Help https://www.microsoft.com/en-au/download/details.aspx?id=2764
Computername
Set WshNetwork = WScript.CreateObject("WScript.Network")
WScript.Echo "Domain = " & WshNetwork.UserDomain
WScript.Echo "Computer Name = " & WshNetwork.ComputerName
WScript.Echo "User Name = " & WshNetwork.UserName
Write Registry
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\ACME\FortuneTeller\", 1, "REG_BINARY"

Teamviewer VBScript Pinging Computers

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

How can I pull the correct data from the HK Current User registry key instead of temp profile information

I am working on a script to pull the value in the key
HKCurrentUser\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop
Currently all it is returning is:
C:\WINDOWS\system32\config\systemprofile\Desktop
When I want/think it should return:
%USERPROFILE%\Desktop
Below is the script that is pulling the infomration from the key and as far as I can tell it should be pulling the correct information. Just wondering if someone can enlighten me as to what I am missing. It also returns the computer name and the logged in username which both return correctly. This is going to be run on quite a few machines remotely.
'These are the constants for the following KEYS'
Const HKClassesRoot = &H80000000 'HKEY_CLASSES_ROOT
Const HKCurrentUser = &H80000001 'HKEY_CURRENT_USER
Const HKLocalMachine = &H80000002 'HKEY_LOCAL_MACHINE
Const HKUsers = &H80000003 'HKEY_USERS
Const HKCurrentConfig = &H80000005 'HKEY_CURRENT_CONFIG
'Setup objects to interact with here'
Set wshShell = WScript.CreateObject("Wscript.Shell")
strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Define variable to store the current user and then pull the current user
Dim currentUser
strCurrentUser = objNetwork.UserName
'find the data in the string we want to get the value from'
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\"
strValueName = "Desktop"
'pull the info and store it in strValue'
objRegistry.GetStringValue HKCurrentUser,strKeyPath,strValueName,strValue
'setup for output of data to the file'
Dim strSpacer
Dim strData
strSpace = "+-------------------------------------------------------------------------------------------------------------------------+"
strData = "| " & strComputer & " == " & strCurrentUser & " == " & strValue & " |"
Dim strFileName
strFileName = "\\server\share\" & strCurrentUser & ".txt"
Set objFile = objFSO.OpenTextFile(strFileName,8,true)
objFile.write vbCrLf & strSpace & vbCrLf
objFile.write strData & vbCrLf
objFile.write strSpace & vbCrLf
'Close file'
objFile.Close
After review I found the answer to my own question. I was reading the registry incorrectly for what I was doing.
strRegkey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop"
strDataValue = wshShell.RegRead(strRegKey)
this returns the value stored currently in the key.
I suspect that the environment variable %USERPROFILE% from the registry value gets expanded to the profile of the user running the WMI service (LOCAL SYSTEM). GetStringValue seems to behave the same as GetExpandedStringValue when reading REG_EXPAND_SZ values.

objShell.Run MailTo populate vars

I have a script I’m trying to run that will grab the IP address and Computer name and popup their default mail client. I can’t figure out how to have the mailto grab the variables.. Any help would be much appreciated!
Set objShell = CreateObject("Wscript.Shell")
Set objEnv = objShell.Environment("Process")
strComputer = objEnv("COMPUTERNAME")
strUser = "Scanner.User"
strPass = "SomePassword"
Set colAccounts = GetObject("WinNT://" & strComputer & ",computer")
Set objUser = colAccounts.Create("user", strUser)
objUser.SetPassword strPass
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
objPasswordExpirationFlag = ADS_UF_DONT_EXPIRE_PASSWD
objUser.Put "userFlags", objPasswordExpirationFlag
objUser.SetInfo
Set Group = GetObject("WinNT://" & strComputer & "/Administrators,group")
Group.Add(objUser.ADspath)
temp = "select IPAddress from Win32_NetworkAdapterConfiguration "& _
"where IPEnabled=TRUE"
temp2 = "winmgmts:{impersonationLevel=impersonate}"
set IPConfigSet = GetObject(temp2).ExecQuery(temp)
for each IPConfig in IPConfigSet
if Not IsNull(IPConfig.IPAddress) then
for i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
objShell.Run("mailto:MyEmail#address.com&subject=strComputer&body=IPConfig.IPAddress(i)")
Msgbox IPConfig.IPAddress(i)
next
end if
next
You need to use ampersand (VBScript's Concatenation Operator) to generate your mailto URI.
objShell.Run("mailto:MyEmail#address.com&subject=" & strComputer & "&body=" & IPConfig.IPAddress(i))

Resources