Some old teeth, this is written for a long time, and it feels that the function is relatively complete.
Download address: http://www.wowor.net/bbs/up/files/2004403_mRegistry.zip
This is a software I have written in this module:
Registry Master 2.0
http://www.onlinedown.net/soft/16780.htm
Standard module code: '*************************************************** *********************************************************** *************** * This module provides some function "WARNING) for the registry" * Warning: Operation registry is very dangerous, use any of this module to be careful !!! '*' * copyright: LPP software studio '* author: Lu Peipei' ******************************************************* *********************************************************** *****************************
Option expedition
Option Compare Text
'------------------------------------- --------------' - Registry API Declaration ...'---------------------------------------------------------------------- -------------------------------------- Private Declare Function Regclosekey LIB "Advapi32.dll" As Long) As LongPrivate Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As LongPrivate Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As LongPrivate Declare Function RegDeleteValue Lib "advapi32.dll" Alias " RegDeleteValueA "(ByVal hKey As Long, ByVal lpValueName As String) As LongPrivate Declare Function RegOpenKeyEx Lib" advapi32.dll "Alias" RegOpenKeyExA "(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Lo ng, phkResult As Long) As LongPrivate Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As LongPrivate Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As LongPrivate Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA"
(ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPrivate 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 LongPrivate Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As LongPrivate Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, LPCBVALUENAME AS STRING, LPCBVALUENAME As Long, Byval LPRESERVED AS Long, LPTYPE AS Long, LPDATA AS BYTE, LPCBDATA AS Long AS Longprivate Declare Function Regenumke yEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long 'Used to adjust your program's security privileges, can 't restore without it! Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long' Returns a valid LUID which is important when making security changes in NT.Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongPrivate Declare Function GetCurrentProcess Lib "kernel32" () As Long '--------- -------------------------------------------------- ---- '- Registry API constant ... -------------------------------------- --------------------------- 'Registry creation type value ... const reg_option_non_volatile = 0 'When the system is restarted, the keyword is retained.
'Registry key security options ... Const READ_CONTROL = & H20000Const KEY_QUERY_VALUE = & H1Const KEY_SET_VALUE = & H2Const KEY_CREATE_SUB_KEY = & H4Const KEY_ENUMERATE_SUB_KEYS = & H8Const KEY_NOTIFY = & H10Const KEY_CREATE_LINK = & H20Const KEY_READ = KEY_QUERY_VALUE KEY_ENUMERATE_SUB_KEYS KEY_NOTIFY READ_CONTROLConst KEY_WRITE = KEY_SET_VALUE KEY_CREATE_SUB_KEY READ_CONTROLConst KEY_EXECUTE = KEY_READConst KEY_ALL_ACCESS = KEY_QUERY_VALUE KEY_SET_VALUE KEY_CREATE_SUB_KEY KEY_ENUMERATE_SUB_KEYS KEY_NOTIFY KEY_CREATE_LINK READ_CONTROL 'return value ... Const ERROR_NONE = 0 = 0Const ERROR_BADKEY = 2Const ERROR_ACCESS_DENIED = 8Const ERROR_SUCCESS' about the import / export constant Const REG_FORCE_RESTORE As Long = 8 & Const TOKEN_QUERY As Long = & H8 & Const TOKEN_ADJUST_PRIVILEGES As Long = & H20 & Const SE_PRIVILEGE_ENABLED As Long = & H2Const SE_RESTORE_NAME = "SeRestorePrivilege" Const SE_BACKUP_NAME = "SeBackupPrivilege"
'------------------------------------- --------------' - Registry type ... --------------------------- - -
Private Type Filetime Dwhighttime As long DWHighDatetime As Longend Type
Private Type Luid LowPart As Long Highpart As Longend Type
Private Type Luid_and_attributes pluid as Luid Attributes As Longend Type
Private Type Token_Privileges Privilegect As long privileges as Luid_and_attributesend Type
'------------------------------------- -------------- 'Custom enumeration type ... ------------------------- -------------------------------------- 'Registry Data Type ... Public Enum ValueType Reg_sz = 1 'string value REG_EXPAND_SZ = 2' expansive string value REG_BINARY = 3 'binary value REG_DWORD = 4' DWORD value REG_MULTI_SZ = 7 'multi-character string value end enum' registration table keying root type ... public enum keyroot HKEY_CLASSES_ROOT = & H80000000 HKEY_CURRENT_USER = & H80000001 HKEY_LOCAL_MACHINE = & H80000002 HKEY_USERS = & H80000003 HKEY_PERFORMANCE_DATA = & H80000004 HKEY_CURRENT_CONFIG = & H80000005 HKEY_DYN_DATA = & H80000006End Enum
Private HKEY AS long 'The Handle of the Registry Open I ask, the J AS long' loop variable The return value of the Variation Variable Variety, the determination function call is successful
'------------------------------------- -------------------------------------------------- ---------- 'New registry keywords and set the registry keyword ...' If Valuename and Value are default, only the keyname empty item, no subkey .. . 'If only default valueename will set the default value of the specified keyName' - Parameter Description: KeyRoot - Root type, keyname - child name, valueName-- value item name, value-- value item data, valuePE- - Value type '------------------------------------------- -------------------------------------------------- -------------- Public Function SetKeyValue (KeyRoot As KeyRoot, KeyName As String, Optional ValueName As String, Optional Value As Variant = "", Optional ValueType As ValueType = REG_SZ) As Boolean Dim lpAttr AS security_attributes' Registry Security Type LPattr.nLength = 50 'Set security properties to default ... lpattr.lpsecurityDescriptor = 0' ... lpattr.binherithandle = true '...' New Registration keyword ... Success = regcreateKeyex (Keyroot, Keyname, 0, ValueType, Reg_Option_non_volatile, key_all_access, lpattr, hkey, 0) If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function 'settings registry keys ... If IsMissing (ValueName) = False Then Select Case ValueType Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ Success = RegSetValueEx (hKey, ValueName , 0, ValueType, BYVAL CSTR (Value), Lenb (StrConv (Value, Vbfromunicode) 1) Case Reg_dword if Cdbl (Value) <= 4294967295 # and cdbl (value)> = 0 Then Dim Svalue As string svalue = doubletohex (Value) DIM DVALUE (3) as byte Dvalue (0) =
Format ("& H" & MID (Svalue, 7, 2)) DVALUE (1) = Format ("& H" & MID (Svalue, 5, 2)) DVALUE (2) = Format ("& H" & MID (Svalue, 3, 2)) DVALUE (3) = Format ("& H" & MID (Svalue, 1, 2)) Success = RegSetValueex (HKEY, VALUENAME, 0, VALUETYPE, DVALUE (0), 4) Else Success = error_badkey End IF Case reg_binary = 1 'assumes calling API unsuccessful (successful return 0) Redim TmpValue (Ubound (value)) AS BYTE for i = 0 To Ubound (tmpValue) TMPVALUE (i) = value (i) Next I Success = RegSetValueEx (hKey, ValueName, 0, ValueType, tmpValue (0), UBound (Value) 1) End Select End If If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function 'close the registry key. .. regcloseKey HKEY setKeyValue = true 'Return Function Value End Function
'------------------------------------- -------------------------------------------------- ----------'- Get the value of the existing registry keyword ...'- If Valuename = "" Returns the default value of the keyName item ...) If the specified registry key Word does not exist, return to the empty string ...'-parameter description: Keyroot - Root type, keyname - child name, valueename - value item name, valueetype - value type '------- -------------------------------------------------- -------------------------------------------------- --Public Function GetKeyValue (KeyRoot As KeyRoot, KeyName As String, ValueName As String, Optional ValueType As Long) As String Dim TempValue As String 'temporary registry key value Dim value As String' registry value Dim valueSize keyword The actual length of the AS long 'registry keyword TempValue = Space (1024)' Store the registry keyword buffer value value value = 1024 'Set the default length of the value of the registry keyword' Open an existing Registry keyword ... regopenkeyex keyroot, keyname, 0, key_all_access, hkey 'Get the value of the opened registry keyword ... RegQueryValueex HKEY, VALUENAME , 0, valueationpe, Returns the value of the registry keyword ... select case valuepe 'by judging the type of keyword, processes Case Reg_SZ, REG_MULTI_SZ, REG_EXPAND_SZ TEMPVALUE = Left $ (TempValue, VALUESIZE - 1 ) 'is removed TempValue trailing spaces Value = TempValue Case REG_DWORD ReDim dValue (3) As Byte RegQueryValueEx hKey, ValueName, 0, REG_DWORD, dValue (0), valueSize For i = 3 To 0 Step -1 Value = Value String (2 - Len (Hex (DValue (i))), "0") HEX (DVALUE (I)) '
Hexadecimal string of generating length 8 Next i if CDBL ("& H" & value) <0 THEN 'converts hexadecimal value = 2 ^ 32 CDBL ("& H" & value) Else Value = CDBL ("& H" End IF Case REG_BINARY IF VALUESIZE> 0 THEN Redim Bvalue (VALUESIZE - 1) AS BYTE 'Stores Reg_binary Values RegqueryValueex HKEY, VALUENAME, 0, REG_BINARY, BVALUE (0), VALUESIZE for i = 0 to VALUESIZE - 1 Value = Value String (2 - Len (HEX (BValue (i)))), "0") HEX (BValue (i)) "" converts array into strings Next I end if End select 'Close Registry Key ... regcloseKey HKEY GETKEYVALUE = TRIM (VALUE)' Return Function Value END FUNCTION
'------------------------------------- -------------------------------------------------- ---------- 'Remove the value of the existing registry keyword ...' If the specified registry keyword does not exist, do not do anything ...'-parameter description: KeyRoot - root type, keyname - child name, value Name "----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------- ----------------------------- Public Function Deletekey (KeyRoot As Keyroot, Keyname As String, Optional Valuename As String) AS Boolean Dim TmpKeyname AS string 'registry keyword Temporary child name DIM TMPVALUENAME AS STRING' Registry keyword Temporary subkey name 'Open an existing registry keyword ... Success = regopenkeyex (Keyroot, Keyname, 0, Key_All_Access , hKey) if Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hKey: Exit Function 'delete open registry key ... tmpKeyName = "" tmpValueName = KeyName if ValueName = "" Then' determine whether ValueName default, If the default processing IF INSTRREV (Keyname, "/")> 1 TMPVALUENAME = Right (Keyname ame, InStrRev (KeyName, "/") 1) tmpKeyName = Left (KeyName, InStrRev (KeyName, "/") - 1) End If Success = RegOpenKeyEx (KeyRoot, tmpKeyName, 0, KEY_ALL_ACCESS, hKey) Success = RegDeleteKey ( hKey, tmpValueName) Else Success = RegDeleteValue (hKey, ValueName) End If If Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hKey: Exit function 'close registry key ... RegCloseKey hKey DeleteKey = True' return function value End function
'------------------------------------- -------------------------------------------------- ----------'- Get some information of the registry keyword ...'-SubkeyName () Name of all child items in the registry keyword (Note: Minimum smaller is 0) '- VALUENAME () Name of all sub-keys in the registry keyword (Note: Minimum smashed 0) '- ValyEType () Registry keyword all child keys (Note: Minimum smaller is 0)' - CountKey Registration The number of children with keyword '- CountValue Registry keyword Number of sub-key' - Maxlenkey registry keyword's Maximum length '- MaxlenValue registry keyword's Maximum length' --------- -------------------------------------------------- -------------------------------------------------- ----- Public Function getKeyInfo (KeyRoot As KeyRoot, KeyName As String, SubKeyName () As String, ValueName () As String, ValueType () As ValueType, Optional CountKey As Long, Optional countValue As Long, Optional MaxLenKey As Long, OPTIONAL MAXLENVALUE AS Long) AS Boolean Dim F AS FileTime Diml AS Long, S AS String 'Opens an existing registry keyword ... Success = regopenkeyex (Keyroot, Keyname, 0, Key_All_access, HKEY) If SUCCESS <> Error_Success Ten GetKeyInfo = FALSE: RegcloseKey HKey: EXIT FUNCTION 'Information for open registry keywords ... Success = RegQueryInfoKey (HKEY, VBNULLSTRINFOKEY (HKEY, VBNULLSTRING, BYVAL 0 &, BYVAL 0 &, CountKey, Maxlenkey, Byval 0 &, CountValue, MaxlenValue, BYVAL 0 &, BYVAL 0 &, F) If SUCCESS <> Error_Success Then getKeyInfo = FALSE: Regclosekey HKEY: EXIT FUNCTION IF CountKey <> 0 Then Redim SubkeyName (CountKey - 1) AS String 'redefined array, matching the quantity of subrson with the registry keyword = 0 to countKey - 1 SubkeyName (i) = space (255) L = 255 Regenkeyex HKey, I, Byval SubkeyName (i), L, 0, VBNULLSTRING, BYVAL 0 &, F SubkeyName (i) =
LEFT (SubkeyName (I), L) NEXT I 'The two cycles of the strings are sorted for I = 0 to Ubound (SubkeyName) for J = i 1 to Ubound (SubkeyName) if SubkeyName (i) > SubkeyName (j) SubkeyName (i) = SubkeyName (i) = SubkeyName (j) Subkeyname (j) = s end if Next j next i endiff value <> 0 THEN Redim Valuename (CountValue - 1) AS String 'Redefining an array, using an array size with the number of subrocks of the registry keyword Match RedIm ValueType (CountValue - 1) as long' redefined array, using array size with the number of sub-key of the registry keyword Match for i = 0 to CountValue - 1 Valuename (i) = Space (255) L = 255 RegenumValue HKEY, I, BYVAL VALUENAME (i), L, 0, ValueType (i), Byval 0 &, ByVal 0 & Valuename (i) = left (Valuename ) Name (i)> Valuename (j) THEN S = VALUENAME (i) VALUENAME (i) = valuename (j) valuename (j) = s end if next j next i end if 'Close Registry Keyword ... RegcloseKey HKey GetKeyInfo = True 'Return Functional Value End Function
'------------------------------------- -------------------------------------------------- ----------'- Value '- Parameter Description: Keyroot - Root Type, Keyname - Export File Path and File Name (Original Database " format)'----------------------------------------------- -------------------------------------------------- ------------ Public Function SaveKey (KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean On Error Resume Next Dim lpAttr As SECURITY_ATTRIBUTES 'types registry security lpAttr.nLength = 50' is provided security attribute default values ... lpAttr.lpSecurityDescriptor = 0 '... lpAttr.bInheritHandle = True' ... If enablePrivilege (SE_BACKUP_NAME) = False Then SaveKey = False Exit Function End If Success = RegOpenKeyEx (KeyRoot, KeyName, 0 &, Key_All_Access, HKEY) IF SUCCESS <> 0 Then SaveKey = false success = regclosekey (hkey) exit function end if success = regsav Ekey (HKEY, FILENAME, LPATTR) IF success = 0 Then SaveKey = true else savekey = false success = regclosekey (HKEY) End Function
'------------------------------------- -------------------------------------------------- ----------'- Import registry keyword value '- Parameter description: Keyroot - Root type, keyname - child name, filename - Imported file path and file name (original database format)'----------------------------------------------- -------------------------------------------------- ------------ Public Function RestoreKey (KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean On Error Resume Next If enablePrivilege (SE_RESTORE_NAME) = False Then RestoreKey = False Exit Function End If Success = RegOpenKeyEx (KeyRoot, KeyName, 0 &, KEY_ALL_ACCESS, hKey) If Success <> 0 Then RestoreKey = False Success = RegCloseKey (hKey) Exit Function End If Success = RegRestoreKey (hKey, FileName, REG_FORCE_RESTORE) If Success = 0 Then RestoreKey = True Else Restorekey = false success = regclosekey (hkey) end function
'------------------------------------- -------------------------------------------------- ---------- 'Allow registry to allow import / export' ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------- ----------------------------- Private Function EnablePrivilege (SENAME AS STRING) AS BOOLELAN ON ERROR RESUME NEXT DIM P_LNGRTN As Long Dim P_LNGTOKEN AS Long Dim p_lngBufferLen As Long Dim p_typLUID As LUID Dim p_typTokenPriv As TOKEN_PRIVILEGES Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES p_lngRtn = OpenProcessToken (GetCurrentProcess (), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lngToken) If p_lngRtn = 0 Then enablePrivilege = False Exit Function End If If Err.LastDllError <> 0 Then enablePrivilege = False Exit Function End If p_lngRtn = LookupPrivilegeValue (0 &, seName, p_typLUID) If p_lngRtn = 0 Then enablePrivilege = False Exit Function End If p_typTokenPriv.PrivilegeCount = 1 p_typT okenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED p_typTokenPriv.Privileges.pLuid = p_typLUID EnablePrivilege = (AdjustTokenPrivileges (p_lngToken, False, p_typTokenPriv, Len (p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <> 0) End Function
'------------------------------------- -------------------------------------------------- ---------- 'converts Double type (limited to 0-2 ^ 32-1) to hexadecimal and fill the zero in front' - parameter description: Number - To convert Double type number '--------------------------------------------- -------------------------------------------------- -------------- Private Function DoubleTohex (Byval Number As Double) AS String Dim strhex as string strinder = space (8) for i = 1 to 8 select case number - int (Number / 16 * 16 case 10 MID (Strhex, 9 - i, 1) = "a" Case 11 MID (Strhex, 9 - i, 1) = "b" Case 12 MID (Strhex, 9 - i, 1) = "C "Case 13 MID (Strhex, 9 - i, 1) =" D "Case 14 MID (Strhex, 9 - i, 1) =" e "Case 15 MID (Strhex, 9 - i, 1) =" f "CASE Else MID (Strhex, 9 - i, 1) = cstr (Number - Int (Number / 16) * 16) end select number = int (Number / 16) NEX T i doubleEtohex = strhexend function * ------------------------------------------- *
* Please inform the author and indicate the source, 9CBS welcomes you! *
* Author: Lu Peipei (goodname008) *
* Email: GoodName008@163.com *
* Column: http://blog.9cbs.net/goodname008 *
* ------------------------------------------- *
