• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    vbs 注册表操作类代码
    复制代码 代码如下:

    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
    您可能感兴趣的文章:
    • vbscript Registry 注册表操作实现代码(读写删除)
    • VBS通过WMI监视注册表变动的代码
    • vbs 注册表操作代码(添加删除)
    • VBS脚本使用WMI操作注册表的代码
    • vbscript 注册表脚本书写
    • vbs删除注册表项的代码
    • 用vbs操作注册表实例代码
    • Vbscript写注册表的方法
    • VBS读取注册表的两种方法
    上一篇:vbs列出内网的中计算机(工作组也可以)
    下一篇:提权vbs代码
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    vbs 注册表操作类代码 vbs,注册表,操作,类,代码,