足球游戏_中国足彩网￥体育资讯$

从国外的一个庞大脚本提取出来的注册表操作类，喜欢的朋友可以收藏下

代码如下:

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