Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing QuickQuery HL Edition/Registry.bas (10.29 KB)
Attribute VB_Name = "Registry"
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
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
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
bErrorOccurred = False
Exit Function
RegError:
RegCloseKey keyhand
bErrorOccurred = 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
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)
bErrorOccurred = False
RegCloseKey keyhand
Exit Function
RegError:
RegCloseKey keyhand
bErrorOccurred = True
End Function
Public Sub CreateKey(hKey As Long, 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
End If
bErrorOccurred = False
Else
bErrorOccurred = True
End If
End Function
Public Function GetRegString(hKey As Long, strPath As String, strValue As String, Optional ByRef bErrorOccurred As Boolean)
Dim keyhand As Long
RegOpenKey hKey, strPath, keyhand
GetRegString = RegQueryStringValue(keyhand, strValue, bErrorOccurred)
RegCloseKey keyhand
End Function
Private Function StripTerminator(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(hKey As Long, strPath As String, strValue As String, 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 strKey As String)
RegDeleteKey hKey, strKey
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 QuickQuery HL Edition/Registry.bas