Option Explicit
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 Long
' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Const HKEY_DYN_DATA = &H80000006
Const REG_BINARY = 3
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_EXPAND_SZ = 2
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_NONE = 0
Const REG_RESOURCE_LIST = 8
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String)
Dim lResult As Long
Dim lValueType As Long
Dim strBuf As String
Dim lDataBufSize As Long
On Error GoTo 0
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
End If
End Function
Public Function GetString(ByVal hKey As Long, ByVal strpath As String, ByVal strvalue As String)
Dim keyhand&
Dim datatype&, r#
r = RegOpenKey(hKey, strpath, keyhand&)
GetString = RegQueryStringValue(keyhand&, strvalue)
r = RegCloseKey(keyhand&)
End Function
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 savestring(ByVal hKey As Long, ByVal strpath As String, ByVal strvalue As String, ByVal strdata As String)
Dim keyhand&, r#
r = RegCreateKey(hKey, strpath, keyhand&)
r = RegSetValueEx(keyhand&, strvalue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand&)
End Sub
Public Sub Delstring(ByVal hKey As Long, ByVal strpath As String, ByVal sKey As String)
Dim keyhand&, r#
r = RegOpenKey(hKey, strpath, keyhand&)
r = RegDeleteValue(keyhand&, sKey)
r = RegCloseKey(keyhand&)
End Sub
Public Sub DeleteKey(ByVal hKey As Long, ByVal strpath As String, ByVal sKey As String)
Dim keyhand&, r#
r = RegOpenKey(hKey, strpath, keyhand&)
r = RegDeleteKey(keyhand&, sKey)
r = RegCloseKey(keyhand&)
End Sub
Public Sub SaveSet(ByVal AppName As String, ByVal Section As String, ByVal Key As Variant, ByVal Value As Variant)
On Error Resume Next
savestring HKEY_CURRENT_USER, "Software\" & App.CompanyName & "\" & AppName & "\" & Section, CStr(Key), CStr(Value)
End Sub
Public Function GetSet(ByVal AppName As String, ByVal Section As String, Key As Variant, Optional Default As Variant = "") As Variant
Dim hKey As Long, subkey As String, stringbuffer As String
Dim datatype As Long, slength As Long, retval As Long
subkey = "Software\" & App.CompanyName & "\" & AppName & "\" & Section
retval = RegOpenKeyEx(HKEY_CURRENT_USER, subkey, 0, KEY_READ, hKey)
stringbuffer = Space(255)
slength = 255
retval = RegQueryValueEx(hKey, Key, 0, datatype, ByVal stringbuffer, slength)
' Only attempt to display the data if it is in fact a string.
GetSet = CStr(Left(stringbuffer, slength - 1))
GetSet = Replace(CStr(Left(stringbuffer, slength - 1)), " ", "")
If Len(GetSet) > 0 Then
GetSet = CStr(Left(stringbuffer, slength - 1))
End If
If GetSet = "" Then GetSet = Default
' Close the registry key.
retval = RegCloseKey(hKey)
End Function
Public Function DelSet(ByVal AppName As String, ByVal Section As String, Key As Variant) As Variant
On Error Resume Next
Delstring HKEY_CURRENT_USER, "Software\" & App.CompanyName & "\" & AppName & "\" & Section, CStr(Key)
End Function
Public Function DelKey(ByVal AppName As String, ByVal Section As String, Key As Variant) As Variant
On Error Resume Next
DeleteKey HKEY_CURRENT_USER, "Software\" & App.CompanyName & "\" & AppName & "\" & Section, CStr(Key)
End Function
