当前位置 博文首页 > vbs 注册表操作类代码

    vbs 注册表操作类代码

    作者:admin 时间:2021-02-13 12:32

    复制代码 代码如下:

    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
    js
    上一篇:提权vbs代码
    下一篇:没有了