Copy Code code 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 = &h00008
Const key_notify = &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 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 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 to 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 is 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 is 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 HkRoo t = 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 is 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 is 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 HkRoo t = hkey_current_config Or hkroot = Hkey_dyn_data Then
Call Objregistry.createkey (Hkroot, Skeypath) ' Create "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 HkRoo t = 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 HkRoo t = 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
