• Home
 · 
• Registry
 · 
• Registry Functions

Registry Functions

Registry Functions

API Declarations


lLowDateTime As Long
lHighDateTime As Long
End Type

Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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 Any, phkResult As Long, lplDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByRef lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long


Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1009&
Private Const ERROR_BADKEY = 1010&
Private Const ERROR_CANTOPEN = 1011&
Private Const ERROR_CANTREAD = 1012&
Private Const ERROR_CANTWRITE = 1013&
Private Const ERROR_OUTOFMEMORY = 14&
Private Const ERROR_INVALID_PARAMETER = 87&
Private Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234&

Private Const REG_NONE = 0&
Private Const REG_SZ = 1&
Private Const REG_EXPAND_SZ = 2&
Private Const REG_BINARY = 3&
Private Const REG_DWORD = 4&
Private Const REG_DWORD_LITTLE_ENDIAN = 4&
Private Const REG_DWORD_BIG_ENDIAN = 5&
Private Const REG_LINK = 6&
Private Const REG_MULTI_SZ = 7&
Private Const REG_RESOURCE_LIST = 8&
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9&
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10&

Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_SET_VALUE = &H2&
Private Const KEY_CREATE_SUB_KEY = &H4&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const KEY_CREATE_LINK = &H20&
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private Const KEY_EXECUTE = KEY_READ

Private hKey As Long, MainKeyHandle As Long
Private rtn As Long, lBuffer As Long, sBuffer As String
Private lBufferSize As Long
Private lDataSize As Long
Private ByteArray() As Byte

'This variable determins wether or not to display error messages to the
'user. I have set the default value to False as an error message can and
'does become irritating after a while. Turn this value to true if you want
'to debug your programming code when reading and writing to your system
'registry, as any errors will be displayed in a message box.

Private DisplayErrorMsg As Boolean



Rate Registry Functions

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'I have added some functions and changed a few of his so they would work on 
'my system. 

'You will want to make this a [FileName].cls module

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Public Registry Functions
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'Function Info:
'   sKey = Key path - ex. "HKEY_LOCAL_MACHINE\SOFTWARE\..."
'   sKeyName = is the key value name - ex. "Company Name"
'   KeyValue = is the item to save in the registry - ex. "Dairy Queen Inc."
'

'-- The Get function will return the value
'Function GetBinaryValue(sKey As String, sKeyName As String)
'Function GetDWORDValue(sKey As String, sKeyName As String)
'Function GetStringValue(sKey As String, sKeyName As String)

'-- Set the value in the registry
'Function SetBinaryValue(sKey As String, sKeyName As String, KeyValue As String)
'Function SetDWORDValue(sKey As String, sKeyName As String, KeyValue As Long)
'Function SetStringValue(sKey As String, sKeyName As String, KeyValue As String)

'-- delete registry key or key value
'Function DeleteKey(sKey As String)
'Function DeleteKeyValue(sKey As String, sKeyName As String)
'Function DeleteAllKeySubItems() ""NOT COMPLETED""

'-- create registry keys
'Function CreateKey(sKey As String)

'-- check for existing registry key or key value name
'Function KeyExist(sKey As String)
'Function KeyValueExist(sKey As String, sKeyName As String)

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Other supporting functions
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'Function GetMainKeyHandle(MainKeyName As String) As Long
'Function GetErrorMsg(lErrorCode As Long) As String
'Private Sub ParseKey(Keyname As String, Keyhandle As Long)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Private Sub Class_Initialize()

    DisplayErrorMsg = False
    
End Sub


Public Property Let SetDisplayErrorMsg(vNewValue As Variant)

    DisplayErrorMsg = vNewValue

End Property


Public Function SetDWordValue(ByVal sKey As String, ByVal sKeyName As String, ByVal KeyValue As Long)

SetDWordValue = False
Call ParseKey(sKey, MainKeyHandle)

If MainKeyHandle Then
   rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key
   If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
      rtn = RegSetValueExA(hKey, sKeyName, 0, REG_DWORD, KeyValue, 4) 'write the value
      If Not rtn = ERROR_SUCCESS Then   'if there was an error writting the value
         If DisplayErrorMsg = True Then 'if the user want errors displayed
            MsgBox GetErrorMsg(rtn)        'display the error
         End If
      Else
         SetDWordValue = True
      End If
      rtn = RegCloseKey(hKey) 'close the key
   Else 'if there was an error opening the key
      If DisplayErrorMsg = True Then 'if the user want errors displayed
         MsgBox GetErrorMsg(rtn) 'display the error
      End If
   End If
End If

End Function


Public Function GetDWordValue(ByVal sKey As String, ByVal sKeyName As String)

Call ParseKey(sKey, MainKeyHandle)

If MainKeyHandle Then
   rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
   If rtn = ERROR_SUCCESS Then 'if the key could be opened then
      rtn = RegQueryValueExA(hKey, sKeyName, 0, REG_DWORD, lBuffer, 4) 'get the value from the registry
      If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
         rtn = RegCloseKey(hKey)  'close the key
         GetDWordValue = lBuffer  'return the value
      Else                        'otherwise, if the value couldnt be retreived
         GetDWordValue = "Error"  'return Error to the user
         If DisplayErrorMsg = True Then 'if the user wants errors displayed
            MsgBox GetErrorMsg(rtn)        'tell the user what was wrong
         End If
      End If
   Else 'otherwise, if the key couldnt be opened
      GetDWordValue = "Error"        'return Error to the user
      If DisplayErrorMsg = True Then 'if the user wants errors displayed
         MsgBox GetErrorMsg(rtn)        'tell the user what was wrong
      End If
   End If
End If

End Function


Public Function SetBinaryValue(ByVal sKey As String, ByVal sKeyName As String, KeyValue As String)

SetBinaryValue = False
Call ParseKey(sKey, MainKeyHandle)

If MainKeyHandle Then
   rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key
   If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
      lDataSize = Len(KeyValue)
      ReDim ByteArray(lDataSize)
      For i = 1 To lDataSize
      ByteArray(i) = Asc(Mid$(KeyValue, i, 1))
      Next
      rtn = RegSetValueExB(hKey, sKeyName, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value
      If Not rtn = ERROR_SUCCESS Then   'if the was an error writting the value
         If DisplayErrorMsg = True Then 'if the user want errors displayed
            MsgBox GetErrorMsg(rtn)        'display the error
         End If
      Else
         SetBinaryValue = True
      End If
      rtn = RegCloseKey(hKey) 'close the key
   Else 'if there was an error opening the key
      If DisplayErrorMsg = True Then 'if the user wants errors displayed
         MsgBox GetErrorMsg(rtn) 'display the error
      End If
   End If
End If

End Function


Public Function GetBinaryValue(ByVal sKey As String, ByVal sKeyName As String)

Call ParseKey(sKey, MainKeyHandle)

If MainKeyHandle Then
   rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
   If rtn = ERROR_SUCCESS Then 'if the key could be opened
      lBufferSize = 1
      rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_BINARY, 0, lBufferSize) 'get the value from the registry
      sBuffer = Space(lBufferSize)
      rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_BINARY, sBuffer, lBufferSize) 'get the value from the registry
      If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
         rtn = RegCloseKey(hKey)  'close the key
         GetBinaryValue = sBuffer 'return the value to the user
      Else                        'otherwise, if the value couldnt be retreived
         GetBinaryValue = "Error" 'return Error to the user
         If DisplayErrorMsg = True Then 'if the user wants to errors displayed
            MsgBox GetErrorMsg(rtn)  'display the error to the user
         End If
      End If
   Else 'otherwise, if the key couldnt be opened
      GetBinaryValue = "Error" 'return Error to the user
      If DisplayErrorMsg = True Then 'if the user wants to errors displayed
         MsgBox GetErrorMsg(rtn)  'display the error to the user
      End If
   End If
End If

End Function


Public Function SetStringValue(ByVal sKey As String, ByVal sKeyName As String, ByVal KeyValue As String)

SetStringValue = False
Call ParseKey(sKey, MainKeyHandle)

If MainKeyHandle Then
   rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key
   If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
      rtn = RegSetValueEx(hKey, sKeyName, 0, REG_SZ, ByVal KeyValue, Len(KeyValue)) 'write the value
      If Not rtn = ERROR_SUCCESS Then   'if there was an error writting the value
         If DisplayErrorMsg = True Then 'if the user wants errors displayed
            MsgBox GetErrorMsg(rtn)        'display the error
         End If
      Else
         SetStringValue = True
      End If
      rtn = RegCloseKey(hKey) 'close the key
   Else 'if there was an error opening the key
      If DisplayErrorMsg = True Then 'if the user wants errors displayed
         MsgBox GetErrorMsg(rtn)        'display the error
      End If
   End If
End If

End Function


Public Function GetStringValue(ByVal sKey As String, ByVal sKeyName As String)

lBufferSize = 0
sBuffer = ""

Call ParseKey(sKey, MainKeyHandle)

If MainKeyHandle Then
   rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
   If rtn = ERROR_SUCCESS Then 'if the key could be opened then
      sBuffer = Space(255)     'make a buffer
      lBufferSize = Len(sBuffer)
      rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry
      If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
         rtn = RegCloseKey(hKey)  'close the key
         sBuffer = Trim(sBuffer)
         GetStringValue = Left(sBuffer, lBufferSize - 1) 'return the value to the user
      Else                        'otherwise, if the value couldnt be retreived
         GetStringValue = "Error" 'return Error to the user
         If DisplayErrorMsg = True Then 'if the user wants errors displayed then
            MsgBox GetErrorMsg(rtn)  'tell the user what was wrong
         End If
      End If
   Else 'otherwise, if the key couldnt be opened
      GetStringValue = "Error"       'return Error to the user
      If DisplayErrorMsg = True Then 'if the user wants errors displayed then
         MsgBox GetErrorMsg(rtn)        'tell the user what was wrong
      End If
   End If
End If

End Function


Public Function CreateKey(ByVal sKey As String)

    CreateKey = False
    Call ParseKey(sKey, MainKeyHandle)
    
    If MainKeyHandle Then
       rtn = RegCreateKey(MainKeyHandle, sKey, hKey) 'create the key
       If rtn = ERROR_SUCCESS Then 'if the key was created then
          rtn = RegCloseKey(hKey)  'close the key
          CreateKey = True
       End If
    End If

End Function


Public Function DeleteKey(ByVal Keyname As String)

    DeleteKey = False
    Call ParseKey(Keyname, MainKeyHandle)
    
    If MainKeyHandle Then
        rtn = RegDeleteKey(MainKeyHandle, Keyname)
        If (rtn <> ERROR_SUCCESS) Then
            If DisplayErrorMsg = True Then 'if the user wants errors displayed then
                MsgBox GetErrorMsg(rtn)    'tell the user what was wrong
            End If
        Else
            DeleteKey = True
        End If
    End If
    
End Function


Public Function DeleteKeyValue(ByVal sKeyName As String, ByVal sValueName As String)

    DeleteKeyValue = False
    Dim hKey As Long         'handle of open key

    Call ParseKey(sKeyName, MainKeyHandle)

    If MainKeyHandle Then

        rtn = RegOpenKeyEx(MainKeyHandle, sKeyName, 0, KEY_WRITE, hKey)   'open the specified key
        If (rtn = ERROR_SUCCESS) Then
            rtn = RegDeleteValue(hKey, sValueName)
            If (rtn <> ERROR_SUCCESS) Then
                If DisplayErrorMsg = True Then 'if the user wants errors displayed then
                    MsgBox GetErrorMsg(rtn)    'tell the user what was wrong
                End If
            Else
                DeleteKeyValue = True
            End If
            rtn = RegCloseKey(hKey)

        End If

    End If

End Function


Public Function DeleteAllKeySubItems()

    DeleteAllKeySubItems = False

End Function


Public Function KeyExist(ByVal sKey As String)
    Dim hKey As Long

    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
        rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
            KeyExist = True
        Else
            KeyExits = False
        End If
    End If
    
End Function


Public Function KeyValueExist(ByVal sKey As String, ByVal sKeyName As String)
    Dim hKey As Long
    Dim lActualType As Long
    Dim lSize As Long
    
    Dim sTmp As String

    Call ParseKey(sKey, MainKeyHandle)

    If MainKeyHandle Then
        
        rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key
        If (rtn = ERROR_SUCCESS) Then
            
            rtn = RegQueryValueEx(hKey, ByVal sKeyName, 0&, lActualType, sTmp, lSize) 'ByVal 0&, lSize)
            If (rtn = ERROR_SUCCESS) Then
                KeyValueExist = True
            Else
                KeyValueExist = False
            End If
        
        End If
        
    End If

End Function


Private Sub ParseKey(Keyname As String, Keyhandle As Long)
    
rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname

If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the is a "\" at the end of the Keyname then
   MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display error to the user
   Exit Sub 'exit the procedure
ElseIf rtn = 0 Then 'if the Keyname contains no "\"
   Keyhandle = GetMainKeyHandle(Keyname)
   Keyname = "" 'leave Keyname blank
Else 'otherwise, Keyname contains "\"
   Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the Keyname
   Keyname = Right(Keyname, Len(Keyname) - rtn)
End If

End Sub


Private Function GetMainKeyHandle(MainKeyName As String) As Long

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
   
Select Case MainKeyName
       Case "HKEY_CLASSES_ROOT"
            GetMainKeyHandle = HKEY_CLASSES_ROOT
       Case "HKEY_CURRENT_USER"
            GetMainKeyHandle = HKEY_CURRENT_USER
       Case "HKEY_LOCAL_MACHINE"
            GetMainKeyHandle = HKEY_LOCAL_MACHINE
       Case "HKEY_USERS"
            GetMainKeyHandle = HKEY_USERS
       Case "HKEY_PERFORMANCE_DATA"
            GetMainKeyHandle = HKEY_PERFORMANCE_DATA
       Case "HKEY_CURRENT_CONFIG"
            GetMainKeyHandle = HKEY_CURRENT_CONFIG
       Case "HKEY_DYN_DATA"
            GetMainKeyHandle = HKEY_DYN_DATA
End Select

End Function

Private Function GetErrorMsg(lErrorCode As Long) As String
    
'If an error does accurr, and the user wants error messages displayed, then
'display one of the following error messages

Select Case lErrorCode
       Case 1009, 1015
            GetErrorMsg = "The Registry Database is corrupt!"
       Case 2, 1010
            GetErrorMsg = "Bad Key Name"
       Case 1011
            GetErrorMsg = "Can't Open Key"
       Case 4, 1012
            GetErrorMsg = "Can't Read Key"
       Case 5
            GetErrorMsg = "Access to this key is denied"
       Case 1013
            GetErrorMsg = "Can't Write Key"
       Case 8, 14
            GetErrorMsg = "Out of memory"
       Case 87
            GetErrorMsg = "Invalid Parameter"
       Case 234
            GetErrorMsg = "There is more data than the buffer has been allocated to hold."
       Case Else
            GetErrorMsg = "Undefined Error Code:  " & Str$(lErrorCode)
End Select

End Function