Vbs registry operation code

Copy codeThe Code is as follows: Option Explicit
Const WBEM_MAX_WAIT = & H80
'Registry Hives
Const HKEY_LOCAL_MACHINE = & H80000002
Const HKEY_CURRENT_USER = & H80000001
Const HKEY_CLASSES_ROOT = & H80000000
Const HKEY_USERS = & H80000003
Const HKEY_CURRENT_CONFIG = & H80000005
Const HKEY_DYN_DATA = & H80000006

'Reg Value Types
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7

'Registry Permissions
Const KEY_QUERY_VALUE = & H00001
Const KEY_SET_VALUE = & H00002
Const KEY_CREATE_SUB_KEY = & H00004
Const KEY_ENUMERATE_SUB_KEYS = & hsf-8
Const key_policy = & H00016
Const KEY_CREATE = & H00032
Const KEY_DELETE = & H10000
Const KEY_READ_CONTROL = & H20000
Const KEY_WRITE_DAC = & H40000
Const KEY_WRITE_OWNER = & H80000

Class std_registry
Private Sub Class_Initialize ()
Set objRegistry = Nothing
End Sub

'Connect to the reg provider for this registy object
Public Function ConnectProvider32 (sComputerName)
ConnectProvider32 = False
Set objRegistry = Nothing
'On Error Resume Next
Dim oLoc: Set oLoc = CreateObject ("Wbemscripting. SWbemLocator ")
Dim oCtx: Set oCtx = CreateObject ("WbemScripting. SWbemNamedValueSet ")
'Force 64 Bit Registry
Call oCtx. Add ("_ ProviderArchitecture", 32)
Call oCtx. Add ("_ RequiredArchitecture", True)
Dim oSvc: Set oSvc = oLoc. ConnectServer (sComputerName, "root \ default", "", "", WBEM_MAX_WAIT, oCtx)
Set objRegistry = oSvc. Get ("StdRegProv ")
If Err. Number = 0 Then
ConnectProvider32 = True
End If
End Function

'Connect to the reg provider for this registy object
Public Function ConnectProvider64 (sComputerName)
ConnectProvider64 = False
Set objRegistry = Nothing
On Error Resume Next
Dim oLoc: Set oLoc = CreateObject ("Wbemscripting. SWbemLocator ")
Dim oCtx: Set oCtx = CreateObject ("WbemScripting. SWbemNamedValueSet ")
'Force 64 Bit Registry
Call oCtx. Add ("_ ProviderArchitecture", 64)
Call oCtx. Add ("_ RequiredArchitecture", True)
Dim oSvc: Set oSvc = oLoc. ConnectServer (sComputerName, "root \ default", "", "", WBEM_MAX_WAIT, oCtx)
Set objRegistry = oSvc. Get ("StdRegProv ")
If Err. Number = 0 Then
ConnectProvider64 = True
End If
End Function

Public Function IsValid ()
IsValid = Eval (Not objRegistry Is Nothing)
End Function

'Used to read values from the registry, Returns 0 for success, all else is error
'Byref data contains the registry value if the functions returns success
'The constants can be used for The sRootKey value:
'Hkey_local_machine
'Hkey_current_user
'Hkey_classes_root
'Hkey_users
'Hkey_current_config
'Hkey_dyn_data
'The constants can be used for The sType value:
'Reg_sz
'Reg_multi_sz
'Reg_expand_sz
'Reg_binary
'Reg_dword
Public Function ReadValue (ByVal hkRoot, ByVal nType, ByVal sKeyPath, ByVal sValueName, ByRef Data)
On Error Resume Next
ReadValue =-1
Dim bReturn, Results
If hkRoot = HKEY_LOCAL_MACHINE Or hkRoot = HKEY_CURRENT_USER Or hkRoot = HKEY_CLASSES_ROOT Or hkRoot = HKEY_USERS Or hkRoot = HKEY_CURRENT_CONFIG Or hkRoot = HKEY_DYN_DATA Then
'Read Value
Select Case nType
Case REG_SZ
ReadValue = objRegistry. GetStringValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_MULTI_SZ
ReadValue = objRegistry. GetMultiStringValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_EXPAND_SZ
ReadValue = objRegistry. GetExpandedStringValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_BINARY
ReadValue = objRegistry. GetBinaryValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_DWORD
ReadValue = objRegistry. GetDWORDValue (hkRoot, sKeyPath, sValueName, Data)
End Select
End If
End Function

'Used to write registry values, returns 0 for success, all else is falure
'
'The constants can be used for The hkRoot value:
'Hkey_local_machine
'Hkey_current_user
'Hkey_classes_root
'Hkey_users
'Hkey_current_config
'Hkey_dyn_data
'The constants can be used for The nType value:
'Reg_sz
'Reg_multi_sz
'Reg_expand_sz
'Reg_binary
'Reg_dword
Function WriteValue (ByVal hkRoot, ByVal nType, ByVal sKeyPath, ByVal sValueName, ByVal Data)
On Error Resume Next
WriteValue =-1 'default error
If hkRoot = HKEY_LOCAL_MACHINE Or hkRoot = HKEY_CURRENT_USER Or hkRoot = HKEY_CLASSES_ROOT Or hkRoot = HKEY_USERS Or hkRoot = HKEY_CURRENT_CONFIG Or hkRoot = HKEY_DYN_DATA Then
Call objRegistry. CreateKey (hkRoot, sKeyPath) 'create the key if not existing...
'Read Value
Select Case nType
Case REG_SZ
WriteValue = objRegistry. SetStringValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_MULTI_SZ
WriteValue = objRegistry. SetMultiStringValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_EXPAND_SZ
WriteValue = objRegistry. SetExpandedStringValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_BINARY
WriteValue = objRegistry. SetBinaryValue (hkRoot, sKeyPath, sValueName, Data)
Case REG_DWORD
WriteValue = objRegistry. SetDWORDValue (hkRoot, sKeyPath, sValueName, Data)
End Select
End If
End Function

Function DeleteValue (ByVal hkRoot, ByVal sKeyPath, ByVal sValueName)
On Error Resume Next
DeleteValue =-1 'default error
If hkRoot = HKEY_LOCAL_MACHINE Or hkRoot = HKEY_CURRENT_USER Or hkRoot = HKEY_CLASSES_ROOT Or hkRoot = HKEY_USERS Or hkRoot = HKEY_CURRENT_CONFIG Or hkRoot = HKEY_DYN_DATA Then
DeleteValue = objRegistry. DeleteValue (hkRoot, sKeyPath, sValueName)
End If
End Function

Public Function DeleteKey (hkRoot, ByVal sKeyPath)
DeleteKey =-1
On Error Resume Next
If hkRoot = HKEY_LOCAL_MACHINE Or hkRoot = HKEY_CURRENT_USER Or hkRoot = HKEY_CLASSES_ROOT Or hkRoot = HKEY_USERS Or hkRoot = HKEY_CURRENT_CONFIG Or hkRoot = HKEY_DYN_DATA Then
Dim arrSubKeys
Dim sSubKey
Call objRegistry. EnumKey (hkRoot, sKeyPath, arrSubkeys)
If IsArray (arrSubkeys) Then
For Each sSubKey In arrSubkeys
Call DeleteKey (hkRoot, sKeyPath & "\" & sSubKey, bForce)
Next
End If
DeleteKey = objRegistry. DeleteKey (hkRoot, sKeyPath)
End If
End Function

'Members Variables
Private objRegistry
End Class
Dim str
Dim r: Set r = New std_registry
If r. ConnectProvider32 (".") Then

If r. ReadValue (HKEY_LOCAL_MACHINE, REG_EXPAND_SZ, "SYSTEM \ CurrentControlSet \ Control \ Session Manager \ Environment", "ComSpec", str) = 0 Then

Wsh. echo str
Else
Wsh. echo str
End If

End If