Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

JavaTweakz

Browsing modRegistry.bas (12.42 KB)

Attribute VB_Name = "modRegistry"

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegEnumKey Lib "advapi32" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegFlushKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegLoadKey Lib "advapi32" Alias "RegLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpFile As String) As Long
Private Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" 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 RegQueryValue Lib "advapi32" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegReplaceKey Lib "advapi32" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long
Private Declare Function RegRestoreKey Lib "advapi32" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function RegSetValue Lib "advapi32" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" 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
Private Declare Function RegUnLoadKey Lib "advapi32" Alias "RegUnLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Private Const REG_NONE = 0                            ' No value type
Private Const REG_SZ = 1                              ' Unicode nul terminated string
Private Const REG_EXPAND_SZ = 2                       ' Unicode nul terminated string
Private Const REG_BINARY = 3                          ' Free form binary
Private Const REG_DWORD = 4                           ' 32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN = 4             ' 32-bit number (same as REG_DWORD)
Private Const REG_DWORD_BIG_ENDIAN = 5                ' 32-bit number
Private Const REG_LINK = 6                            ' Symbolic Link (unicode)
Private Const REG_MULTI_SZ = 7                        ' Multiple Unicode strings
Private Const REG_RESOURCE_LIST = 8                   ' Resource list in the resource map
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9        ' Resource list in the hardware description
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Private Const REG_CREATED_NEW_KEY = &H1               ' New Registry Key created
Private Const REG_OPENED_EXISTING_KEY = &H2           ' Existing Key opened
Private Const REG_WHOLE_HIVE_VOLATILE = &H1           ' Restore whole hive volatile
Private Const REG_REFRESH_HIVE = &H2                  ' Unwind changes to last flush
Private Const REG_NOTIFY_CHANGE_NAME = &H1            ' Create or delete (child)
Private Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Private Const REG_NOTIFY_CHANGE_LAST_SET = &H4        ' Time stamp
Private Const REG_NOTIFY_CHANGE_SECURITY = &H8
Private Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)

' Reg Create Type Values...

Private Const REG_OPTION_RESERVED = 0           ' Parameter is reserved
Private Const REG_OPTION_NON_VOLATILE = 0       ' Key is preserved when system is rebooted
Private Const REG_OPTION_VOLATILE = 1           ' Key is not preserved when system is rebooted
Private Const REG_OPTION_CREATE_LINK = 2        ' Created key is a symbolic link
Private Const REG_OPTION_BACKUP_RESTORE = 4     ' open for backup or restore
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const STANDARD_RIGHTS_WRITE = &H20000
Private Const STANDARD_RIGHTS_EXECUTE = &H20000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const DELETE = &H10000
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000
Private Const SYNCHRONIZE = &H100000

' Reg Key Security Options

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 KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Private Const ERROR_SUCCESS = 0
Private Const ERROR_NO_MORE_ITEMS = 259

Public Function GetRegDWORD(ByVal hKey As Long, ByVal KeyPath As String, ByVal ValueName As String, Optional ByRef bErrorOccurred As Boolean) As Long

    Dim lResult As Long
    Dim keyhand As Long
    Dim temp As Long
    Dim TempEx As Long
    
    bErrorOccurred = False
    
    lResult = RegOpenKey(hKey, KeyPath, keyhand)
    If lResult <> ERROR_SUCCESS Then GoTo RegError
    
    lResult = RegQueryValueEx(keyhand, ValueName, 0&, TempEx, temp, 4&)
    If lResult <> ERROR_SUCCESS Then GoTo RegError
    
    If TempEx& = REG_DWORD Then GetRegDWORD = temp
    
    RegCloseKey keyhand
        
    Exit Function
    
RegError:

    RegCloseKey keyhand
    bErrorOccurred = True
    
End Function
Public Function RegEnumString(ByVal hKey As Long, ByVal strPath As String, ByRef sNameArray() As String, ByRef sValueArray() As String) As Boolean

    Dim keyhand As Long
    Dim Retcode As Long
    Dim lIndex As Long
    Dim lType As Long
    Dim lVName As Long
    Dim aVName As String
    Dim lData As Long
    Dim aData() As Byte
    
    ReDim sNameArray(0)
    ReDim sValueArray(0)
    
    Retcode = RegOpenKeyEx(hKey, strPath, 0, KEY_QUERY_VALUE, keyhand)
    
    If Retcode = 0 And keyhand <> 0 Then
    
        lIndex = 0
        lVName = 255
        aVName = String(lVName, vbNullChar)
        lData = 255
        
        ReDim aData(lData)
        
        Retcode = RegEnumValue(keyhand, lIndex, aVName, lVName, ByVal 0&, lType, aData(0), lData)
        Do Until Retcode = ERROR_NO_MORE_ITEMS
            If lType = REG_SZ Or lType = REG_EXPAND_SZ Then
                ReDim Preserve sNameArray(UBound(sNameArray) + 1)
                ReDim Preserve sValueArray(UBound(sValueArray) + 1)
                sNameArray(UBound(sNameArray)) = StripTerminator(Left(aVName, lVName))
                sValueArray(UBound(sValueArray)) = StripTerminator(Left(StrConv(aData, vbUnicode), lData))
            End If
            lVName = 255
            aVName = String(lVName, vbNullChar)
            lData = 255
            ReDim aData(lData)
            lIndex = lIndex + 1
            Retcode = RegEnumValue(keyhand, lIndex, aVName, lVName, ByVal 0&, lType, aData(0), lData)
        Loop
    Else
        RegEnumString = False
    End If
    
    Retcode = RegCloseKey(keyhand)
    RegEnumString = True
    
End Function

Public Sub SaveRegDWORD(ByVal hKey As Long, ByVal KeyPath As String, ByVal ValueName As String, ByVal Value As Long)

    Dim keyhand As Long
    
    RegCreateKey hKey, KeyPath, keyhand
    RegSetValueEx keyhand, ValueName, 0&, REG_DWORD, Value, 4&
    RegCloseKey keyhand
    
End Sub

Public Sub SaveRegBinary(ByVal hKey As Long, ByVal KeyPath As String, ByVal ValueName As String, ByVal Value As String)

    Dim keyhand As Long
    
    RegCreateKey hKey, KeyPath, keyhand
    RegSetValueEx ByVal keyhand, ByVal ValueName, ByVal 0&, ByVal REG_BINARY, ByVal Value, ByVal Len(Value)
    RegCloseKey keyhand
    
End Sub

Public Function GetRegBinary(ByVal hKey As Long, ByVal KeyPath As String, ByVal ValueName As String, Optional ByVal lBufferSize As Long = 10000, Optional ByRef bErrorOccurred As Boolean) As String

    Dim lResult As Long
    Dim keyhand As Long
    Dim TempEx As Long
    Dim dataBuffer As String
    
    bErrorOccurred = False
    
    dataBuffer = Space(lBufferSize)
    
    lResult = RegOpenKeyEx(ByVal hKey, ByVal KeyPath, ByVal 0, ByVal KEY_READ, keyhand)
    If lResult <> ERROR_SUCCESS Then GoTo RegError
    
    lResult = RegQueryValueEx(ByVal keyhand, ByVal ValueName, ByVal 0&, TempEx, ByVal dataBuffer, lBufferSize)
    If lResult <> ERROR_SUCCESS Then GoTo RegError
    
    If TempEx = REG_BINARY Then GetRegBinary = Left(dataBuffer, lBufferSize)
    
    RegCloseKey keyhand
    
    Exit Function
    
RegError:

    RegCloseKey keyhand
    bErrorOccurred = True
    
End Function

Public Sub CreateKey(ByVal hKey As Long, ByVal strPath As String)

    Dim keyhand As Long
    
    RegCreateKey hKey, strPath, keyhand
    RegCloseKey keyhand
    
End Sub

Private Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String, Optional ByRef bErrorOccurred As Boolean) As String

    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    
    lResult = RegQueryValueEx(hKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            strBuf = String(lDataBufSize, " ")
            lResult = RegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
            If lResult = ERROR_SUCCESS Then RegQueryStringValue = StripTerminator(strBuf)
        End If
        bErrorOccurred = False
    Else
        bErrorOccurred = True
    End If
    
End Function


Public Function GetRegString(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, Optional ByRef bErrorOccurred As Boolean) As String

    Dim keyhand As Long
    
    RegOpenKey hKey, strPath, keyhand
    GetRegString = RegQueryStringValue(keyhand, strValue, bErrorOccurred)
    RegCloseKey keyhand
    
End Function


Private Function StripTerminator(ByVal strString As String) As String

    Dim intZeroPos As Integer
    
    intZeroPos = InStr(strString, Chr(0))
    If intZeroPos > 0 Then
        StripTerminator = Left(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
    
End Function



Public Sub SaveRegString(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, ByVal strData As String)

    Dim keyhand As Long
    
    RegCreateKey hKey, strPath, keyhand
    RegSetValueEx keyhand, strValue, 0, REG_SZ, ByVal strData, Len(strData)
    RegCloseKey keyhand
    
End Sub


Public Function DeleteKey(ByVal hKey As Long, ByVal strPath As String, ByVal strSubKey As String)

    Dim keyhand As Long

    RegOpenKey hKey, strPath, keyhand
    RegDeleteKey keyhand, strSubKey
    RegCloseKey keyhand
    
End Function


Public Function DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)

    Dim keyhand As Long

    RegOpenKey hKey, strPath, keyhand
    RegDeleteValue keyhand, strValue
    RegCloseKey keyhand
    
End Function



Download modRegistry.bas

Back to file list


Back to project page