Change/Set String values in the registry using SBL Read Part taken from the Kofax forum.

20080520 : Added Reg Set String Value? function


' ***** HIVE Constants *****
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

' Security constant
Const KEY_READ = &H20019&
Const KEY_ALL_ACCESS = &HF003F&

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

'Error constant
Const ERROR_SUCCESS = 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_ARENA_TRASHED = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259


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
Declare Function RegQueryValueEx Lib "advapi32.dll" 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         
'Note that if the lpData parameter is a String, you must pass it By Value.
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" ( ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME ) As Long
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Integer, lpcbData As Long) As Long
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


'Note: lHive must be one of the HKEY constants
Function RegGetStringValue(lHive As Long, Path As String, Key As String) As String
   Dim ret As Long               'returned by registry functions, should be ERROR_SUCCESS
   Dim lpHKey As Long            'handle to opened key
   Dim lpcbData As Long          'length of data in returned string
   Dim sBuffer As String         'buffer for string value
   Dim lpType As Long            'type of value read
   'check if lHive is in a valid range
   If lHive >= HKEY_CLASSES_ROOT And lHive <= HKEY_DYN_DATA Then
      'open key
      ret = RegOpenKeyEx(lHive, Path, 0&, KEY_READ, lpHKey)
      If ret <> ERROR_SUCCESS Then
         RegGetStringValue = ""
         Exit Function     'No key open, so leave
      End If

      ' Set up buffer for data to be returned in.
      ' Adjust next value for larger buffers.
      lpcbData = 1024
      sBuffer = Space$(lpcbData)

      'now read key
      ret = RegQueryValueEx(lpHKey, Key, ByVal 0&, lpType, ByVal sBuffer, lpcbData)
      If ret <> ERROR_SUCCESS Then
         RegGetStringValue = ""   'Simply return empty string in case of error
      Else
         RegGetStringValue = Left$(sBuffer, lpcbData - 1)
      End If
      'always close open key
      ret = RegCloseKey(lpHKey)
   End If
End Function

'Note: lHive must be one of the HKEY constants
' RegSetStringValue By Ivar Snaaijer
Function RegSetStringValue(lHive As Long, Path As String, Key As String, Value As String) As Long
   Dim ret As Long               'returned by registry functions, should be ERROR_SUCCESS
   Dim lpcbData As Long          'length of data in returned string
   Dim lpHKey As Long            'handle to opened key
   'check if lHive is in a valid range
   If lHive >= HKEY_CLASSES_ROOT And lHive <= HKEY_DYN_DATA Then
      'open key
      ret = RegOpenKeyEx(lHive, Path, 0&, KEY_ALL_ACCESS, lpHKey)
      If ret <> ERROR_SUCCESS Then
         RegSetStringValue = ret
         Exit Function     'No key open, so leave
      End If
     lpcbData = Len(Value) +2
      'now read key
      ret = RegSetValueEx(lpHKey, Key, ByVal 0&, REG_SZ, ByVal Value, lpcbData )
      RegSetStringValue = ret   'check for ERROR_SUCCESS in calling function

      'always close open key
      ret = RegCloseKey(lpHKey)
   End If
End Function

Sub Main()
   'just for testing
   Call RegSetStringValue(HKEY_CURRENT_USER, "SOFTWARE\\Kofax Image Products\\Ascent Capture", "TestString", "Waarde")
   MsgBox RegGetStringValue(HKEY_CURRENT_USER, "SOFTWARE\\Kofax Image Products\\Ascent Capture", "TestString")
End Sub 



Gesponsorde koppelingen