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