How to create a registry key with VBS? - vbscript

Question

Okay, I will try asking this question again.
I used this code:
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\test", 1, "REG_DWORD"
I get the error 'Invalid root in registry key' Code: 80070005 (Access Denied)
The code works with other registry roots. I am logged on as an administrator. It works when I run it from an elevated command prompt. But I am making this VBS as a prank to a friend to make him not know what I'm doing. Any ideas?

Answer 1

The best way to distribute registry setting is by exporting the part of a registry where this setting is active to a .reg file with the registry editor. In the save part of the export dialog you choose Win9x/NT4 as format. You can check the .reg file with an editor. The user only has to double click the .reg file and confirm the prompt and possibly reboot his pc. Even normal users should be able to do this. If the registrybranch you try to change is protected by security he wil have to do this with admin right and possibly (depenidng on OS version) start regedit with the the regedt32.exe executable and first adapt the security of that branch so that it can be changed.
Doing this with a script means having to pass additional layers of security to make sure this isn't a malicious script.

Answer 2

Sub x86Win32ScriptingElevate()
in WinXP and Win7 - its works fine:
Call x86Win32ScriptingElevate()
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\test", 1, "REG_DWORD"
WScript.Quit
'*** v13.3 *** www.dieseyer.de *****************************
Sub x86Win32ScriptingElevate()
'***********************************************************
' http://dieseyer.de/scr/elevate.vbs
' Unter Windows x64 laufen VBS' nach einem Doppelklick in der x64-Umgebung
' mit %WinDi%\System32\wscript.exe oder mit %WinDi%\System32\cscript.exe.
' In der x64-Umgebung laufen VBS aber nicht (richtig). Die Prozedur
' x86Win32ScriptingElevate() erkennt dies und startet ggf. das VBS in der
' x86-Umgebung mit
' %WinDirr%\SysWOW64\wscript.exe bzw. mit
' %WinDirr%\SysWOW64\cscript.exe
Dim VBSExe, Tst, TxtArg, i
' MsgBox WScript.FullName & vbCRLF & vbFalse & "..." & False & vbCRLF & wscript.arguments.named.exists("elevated"), , "173 :: "
If wscript.arguments.named.exists("elevated") = True then Exit Sub
' Argumentte sammeln
Dim Args : Set Args = Wscript.Arguments
For i = 0 to Args.Count - 1 ' hole alle Argumente
TxtArg = TxtArg & " " & Args( i )
Next
TxtArg = Trim( TxtArg )
' MsgBox ">" & TxtArg & "<", , "184 :: "
VBSExe = UCase( WScript.FullName )
' x86- / Win32-Systeme haben KEIN %WinDir%\SysWOW64\ - Verzeichnis
Tst = Replace( VBSExe, "\SYSTEM32\", "\SYSWOW64\" )
If CreateObject("Scripting.FileSystemObject").FileExists( Tst ) Then VBSExe = Tst
' VBS mit /elevate starten - ggf. auf x64-System in Win32-Umgebung
' Msgbox """" & VBSExe & """ """ & WScript.ScriptFullName & """ " & TxtArg , , "196 :: "
Tst = createobject("Shell.Application").ShellExecute( """" & VBSExe & """", """" & wscript.scriptfullname & """ " & TxtArg & " /elevated", "", "runas", 1 )
WScript.Quit( Tst )
End Sub ' x86Win32ScriptingElevate()