欢迎大家访问我的网站!

VB操作注册表

思博2022-03-30 03:44:07437编程开发

方法一:

Set w = CreateObject("wscript.shell")

w.regdelete "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\ScDesktop"


方法二:

模块

Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const HKEY_CURRENT_CONFIG = &H80000005

Public Const HKEY_CURRENT_USER = &H80000001

Public Const HKEY_DYN_DATA = &H80000006

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const HKEY_USERS = &H80000003

Public Const REG_OPTION_NON_VOLATILE = 0

Public Const KEY_ALL_ACCESS = (&H20000 Or &H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H20) And (Not &H100000)

Public Const REG_SZ = 1

Public Const REG_DWORD = 4

'*****************************************************************


'*****下面声明注册表操作中用到的API函数****************************

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal uloptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

Public Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

'****************************注册表操作函数**********************

'声明:以下代码由轻风工作室REDICE编写,引用时请作一说明。

'****************************************************************


'*****下面先声明一些常量******************************************

'*****************************************************************


'*****下面是我自己写的一些注册表操作中常用的一些函数**************

'*****新键注册表项

Public Function createnewkey(ip As Long, snewkeyname As String)

     Dim hnewkey As Long

     Dim retval As Long

     retval = RegCreateKey(ip, snewkeyname, hnewkey)

     If retval = 0 Then

       RegCloseKey (hnewkey)   '关闭上面建立或打开的项

     End If

End Function

'实例:在HKEY_CURRENT_USER下建立项"xiaopeng"

'代码为 createnewkey HKEY_CURRENT_USER ,"xiaopeng"

'******************************************************************


'*******删除注册表项***********************************************

Public Function deletekey(ip As Long, skeyname As String)

     Dim hKey As Long

     Dim retval As Long

     retval = RegOpenKeyEx(ip, skeyname, 0, KEY_ALL_ACCESS, hKey)

     If retval = 0 Then

       RegDeleteKey ip, skeyname

     End If

End Function

'实例:删除上面建立的HKEY_CURRENT_USER下的项"xiaopeng"

'代码为 deletekey HKEY_CURRENT_USER ,"xiaopeng"

'******************************************************************


'********新建,设置数值名称*****************************************

Public Function setkeyvalue(ByVal ip As Long, ByVal keyname As String, ByVal valuename As String, ByVal valuesetting As Variant, ByVal valuetype As Long)

     Dim retval As Long

     Dim hKey As Long

     If RegOpenKeyEx(ip, keyname, 0, KEY_ALL_ACCESS, hKey) > 0 Then Exit Function

     Select Case valuetype

           Case REG_SZ

             RegSetValueExString hKey, valuename, 0&, REG_SZ, valuesetting, Len(valuesetting)

           Case REG_DWORD

             RegSetValueExLong hKey, valuename, 0, valuetype, valuesetting, 4

     End Select

     RegCloseKey (hKey)

End Function

'实例:在HKEY_CURRENT_USER下的项"xiaopeng"中建立名为"redice",键值为"is xiaopeng",类型为REG_SZ的新键

'代码为 setkeyvalue HKEY_CURRENT_USER ,"xiaopeng" ,"redice","is xiaopeng",REG_SZ

'又如:在HKEY_CURRENT_USER下的项"xiaopeng"中建立名为"ceshi",键值为2,类型为REG_DWORD的新键

'代码为"setkeyvalue HKEY_CURRENT_USER,"xiaopeng","ceshi",2,REG_DWORD

'******************************************************************


'*********删除数值名称*********************************************

Public Function deletevalue(ByVal ip As Long, ByVal keyname As String, ByVal valuename As String)

     Dim retval As Long

     Dim hKey As Long

     retval = RegOpenKeyEx(ip, keyname, 0, KEY_ALL_ACCESS, hKey)

     If retval > 0 Then

         Exit Function

     End If

     RegDeleteValue hKey, valuename

     RegCloseKey hKey

End Function

'实例:删除HKEY_CURRENT_USER下的项"xiaopeng"中名为"redice"的新键

'代码为 deletevalue HKEY_CURRENT_USER ,"xiaopeng","redice"

'******************************************************************

'**********查询已存在的数值内容************************************

Public Function getvalue(ByVal ip As Long, keyname As String, valuename As String) As String

     Dim retval As Long

     Dim hKey As Long

     Dim valuesetting As Variant

     Dim cddata As Long

     Dim lvalue As Long

     Dim svalue As String

     Dim lvaluetye As Long

     retval = RegOpenKeyEx(ip, keyname, 0, KEY_ALL_ACCESS, hKey)

     If retval > 0 Then

       getvalue = ""

       Exit Function

     End If

     retval = RegQueryValueEx(hKey, valuename, 0, lvaluetype, ByVal vbNullString, cddata)

     If retval <> 0 Then

       RegCloseKey hKey

       Exit Function

     End If

     Select Case lvaluetype

           Case REG_SZ

                 svalue = String(cddata, Chr(0))

                 RegQueryValueEx hKey, valuename, 0, lvaluetype, ByVal svalue, cddata

                 valuesetting = Left$(svalue, cddata)

                 getvalue = CStr(valuesetting)

           Case REG_DWORD

                 RegQueryValueEx hKey, valuename, 0, lvaluetype, lvalue, cddata

                 valuesetting = lvalue

                 getvalue = CStr(valuesetting)

     End Select

End Function

'实例:获取HKEY_CURRENT_USER下的项"xiaopeng"中名为"redice"的新键的键值

'代码为 getvalue HKEY_CURRENT_USER ,"xiaopeng","redice"

'*********************************************************************

窗体


Private Sub Command2_Click()

deletevalue HKEY_CURRENT_USER, "xiaopeng", "redice"

     End Sub


转载声明:本站发布文章及版权归原作者所有,转载本站文章请注明文章来源!

本文链接:http://lxkj.vip/?id=69

网友评论