215 lines
8.0 KiB
QBasic
215 lines
8.0 KiB
QBasic
Attribute VB_Name = "modRegistry"
|
|
' *shared*
|
|
|
|
Option Explicit
|
|
|
|
Public Const REG_SZ As Long = 1
|
|
Public Const REG_DWORD As Long = 4
|
|
|
|
Public Const HKEY_CLASSES_ROOT As Long = &H80000000
|
|
Public Const HKEY_CURRENT_USER As Long = &H80000001
|
|
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
|
|
Public Const HKEY_USERS As Long = &H80000003
|
|
Public Const lpRegKey As String = "SOFTWARE\lindner & partner\"
|
|
|
|
Const KEY_ALL_ACCESS As Long = &H3F
|
|
|
|
Const REG_OPTION_NON_VOLATILE = 0
|
|
|
|
Const STANDARD_RIGHTS_ALL As Long = &H1F0000
|
|
Const READ_CONTROL As Long = &H20000
|
|
Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
|
|
Const KEY_QUERY_VALUE As Long = &H1
|
|
Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
|
|
Const KEY_NOTIFY As Long = &H10
|
|
Const SYNCHRONIZE As Long = &H100000
|
|
Const KEY_READ As Long = _
|
|
((STANDARD_RIGHTS_READ _
|
|
Or KEY_QUERY_VALUE _
|
|
Or KEY_ENUMERATE_SUB_KEYS _
|
|
Or KEY_NOTIFY) _
|
|
And (Not SYNCHRONIZE))
|
|
|
|
Const ERROR_NONE = 0
|
|
Const ERROR_BADDB = 1
|
|
Const ERROR_BADKEY = 2
|
|
Const ERROR_CANTOPEN = 3
|
|
Const ERROR_CANTREAD = 4
|
|
Const ERROR_CANTWRITE = 5
|
|
Const ERROR_OUTOFMEMORY = 6
|
|
Const ERROR_INVALID_PARAMETER = 7
|
|
Const ERROR_ACCESS_DENIED = 8
|
|
Const ERROR_INVALID_PARAMETERS = 87
|
|
Const ERROR_NO_MORE_ITEMS = 259
|
|
|
|
|
|
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 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, ByVal lpSecurityAttributes _
|
|
As Long, phkResult As Long, lpdwDisposition As Long) As Long
|
|
|
|
Private Declare Function RegQueryValueExString 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 RegQueryValueExLong Lib "advapi32.dll" Alias _
|
|
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
|
|
String, ByVal lpReserved As Long, lpType As Long, lpData As _
|
|
Long, lpcbData As Long) As Long
|
|
|
|
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
|
|
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
|
|
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
|
|
As Long, lpcbData As Long) As Long
|
|
|
|
Private 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
|
|
|
|
Private 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
|
|
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Name : GetRegSetting
|
|
' Purpose :
|
|
' Parameters : NA
|
|
' Return val : NA
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Public Function GetRegSetting(ByVal RegHKey As String, ByVal SUBKEY As String, _
|
|
Key As String, ByVal RegTyp As Long, Optional Default As Variant)
|
|
Dim sRetVal As String
|
|
Dim lRetVal As Long
|
|
Dim lrc As Long
|
|
Dim hKey As Long
|
|
Dim lValLen As Long
|
|
|
|
If IsMissing(Default) Then
|
|
If RegTyp = REG_SZ Then
|
|
GetRegSetting = ""
|
|
ElseIf RegTyp = REG_DWORD Then
|
|
GetRegSetting = 0
|
|
End If
|
|
Else
|
|
GetRegSetting = Default
|
|
End If
|
|
sRetVal = String(255, 0)
|
|
lValLen = Len(sRetVal)
|
|
|
|
lrc = RegOpenKeyEx(RegHKey, SUBKEY, 0&, KEY_READ, hKey)
|
|
If RegTyp = REG_SZ Then
|
|
lrc = RegQueryValueExString(hKey, Key, 0&, RegTyp, sRetVal, lValLen)
|
|
sRetVal = Left(sRetVal, lValLen - 1)
|
|
If lrc = 0 Then GetRegSetting = sRetVal
|
|
ElseIf RegTyp = REG_DWORD Then
|
|
lrc = RegQueryValueExLong(hKey, Key, 0&, RegTyp, lRetVal, lValLen)
|
|
If lrc = 0 Then GetRegSetting = lRetVal
|
|
End If
|
|
lrc = RegCloseKey(hKey)
|
|
End Function
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Name : SaveRegSetting
|
|
' Purpose :
|
|
' Parameters : NA
|
|
' Return val : NA
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Public Sub SaveRegSetting(ByVal RegHKey As String, ByVal SUBKEY As String, Key As String, _
|
|
ByVal Value As Variant, ByVal RegTyp As Long)
|
|
Dim hNewKey As Long 'handle to the new key
|
|
Dim lRetVal As Long 'result of the RegCreateKeyEx function
|
|
Dim sValue As String
|
|
Dim lValue As Long
|
|
|
|
lRetVal = RegCreateKeyEx(RegHKey, SUBKEY, 0&, _
|
|
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
|
|
0&, hNewKey, lRetVal)
|
|
If RegTyp = REG_DWORD Then
|
|
lValue = CLng(Value)
|
|
lRetVal = RegSetValueExLong(hNewKey, Key, 0&, REG_DWORD, lValue, 4)
|
|
ElseIf RegTyp = REG_SZ Then
|
|
sValue = Value & Chr$(0)
|
|
lRetVal = RegSetValueExString(hNewKey, Key, 0&, REG_SZ, sValue, Len(sValue))
|
|
End If
|
|
RegCloseKey (hNewKey)
|
|
End Sub
|
|
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Name : GetLPRegSetting
|
|
' Purpose :
|
|
' Parameters : NA
|
|
' Return val : NA
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Public Function GetLPRegSetting(ByVal RegHKey As String, ByVal SUBKEY As String, _
|
|
Key As String, ByVal RegTyp As Long, Optional Default As Variant)
|
|
Dim sRetVal As String
|
|
Dim lRetVal As Long
|
|
Dim lrc As Long
|
|
Dim hKey As Long
|
|
Dim lValLen As Long
|
|
|
|
If IsMissing(Default) Then
|
|
If RegTyp = REG_SZ Then
|
|
GetLPRegSetting = ""
|
|
ElseIf RegTyp = REG_DWORD Then
|
|
GetLPRegSetting = 0
|
|
End If
|
|
Else
|
|
GetLPRegSetting = Default
|
|
End If
|
|
sRetVal = String(255, 0)
|
|
lValLen = Len(sRetVal)
|
|
|
|
lrc = RegOpenKeyEx(RegHKey, lpRegKey & SUBKEY, _
|
|
0&, KEY_READ, hKey)
|
|
If RegTyp = REG_SZ Then
|
|
lrc = RegQueryValueExString(hKey, Key, 0&, RegTyp, sRetVal, lValLen)
|
|
sRetVal = Left(sRetVal, lValLen - 1)
|
|
If lrc = 0 Then GetLPRegSetting = sRetVal
|
|
ElseIf RegTyp = REG_DWORD Then
|
|
lrc = RegQueryValueExLong(hKey, Key, 0&, RegTyp, lRetVal, lValLen)
|
|
If lrc = 0 Then GetLPRegSetting = lRetVal
|
|
End If
|
|
lrc = RegCloseKey(hKey)
|
|
End Function
|
|
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Name : SaveLPRegSetting
|
|
' Purpose :
|
|
' Parameters :
|
|
' Return val : NA
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Public Sub SaveLPRegSetting(ByVal RegHKey As String, ByVal SUBKEY As String, Key As String, _
|
|
ByVal Value As Variant, ByVal RegTyp As Long)
|
|
Dim hNewKey As Long 'handle to the new key
|
|
Dim lRetVal As Long 'result of the RegCreateKeyEx function
|
|
Dim sValue As String
|
|
Dim lValue As Long
|
|
|
|
lRetVal = RegCreateKeyEx(RegHKey, lpRegKey & SUBKEY, 0&, _
|
|
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
|
|
0&, hNewKey, lRetVal)
|
|
If RegTyp = REG_DWORD Then
|
|
lValue = CLng(Value)
|
|
lRetVal = RegSetValueExLong(hNewKey, Key, 0&, REG_DWORD, lValue, 4)
|
|
Else
|
|
sValue = Value & Chr$(0)
|
|
lRetVal = RegSetValueExString(hNewKey, Key, 0&, REG_SZ, sValue, Len(sValue))
|
|
End If
|
|
RegCloseKey (hNewKey)
|
|
End Sub
|
|
|