Shulou(Shulou.com)06/03 Report--

This article is about how vbs implements registry manipulation classes. The editor thinks it is very practical, so share it with you as a reference and follow the editor to have a look.

The 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 = & 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 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

Thank you for reading! On "vbs how to achieve registry operation class" this article is shared here, I hope the above content can be of some help to you, so that you can learn more knowledge, if you think the article is good, you can share it out for more people to see it!

Welcome to subscribe "Shulou Technology Information " to get latest news, interesting things and hot topics in the IT industry, and controls the hottest and latest Internet news, technology news and IT industry trends.