home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 February / Chip_2002-02_cd1.bin / zkuste / vbasic / Data / Utility / RegWiz.exe / Dev / RegWiz / MRegistry.bas next >
BASIC Source File  |  2000-01-27  |  10KB  |  178 lines
  1. Attribute VB_Name = "MRegistry"
  2. Option Explicit
  3.  
  4. Private Const MODULE_NAME = "MRegistry"
  5. Private Err As New CGUIErr
  6. '---------------------------------------------------------------
  7. '-Registry API Declarations...
  8. '---------------------------------------------------------------
  9.  
  10. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  11. Private Declare Function RegCreateKeyEx Lib "advapi32" 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, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
  12. 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
  13. 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
  14. Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
  15.  
  16. '--------------------------------------------------------------------
  17. ' Constants for configuring the build tool - Registry
  18. '--------------------------------------------------------------------
  19. Public Const REGISTRY_PATH = "Software\OrangeAndBlack\RegWiz"
  20. Public Const REGISTRY_KEY_PATH = "Path"
  21. Public Const REGISTRY_KEY_FILTER = "Filter"
  22. Public Const REGISTRY_KEY_RECURSE = "Recurse"
  23.  
  24. '---------------------------------------------------------------
  25. '- Registry Api Constants...
  26. '---------------------------------------------------------------
  27. ' Reg Data Types...
  28. Const REG_SZ = 1                         ' Unicode nul terminated string
  29. Const REG_EXPAND_SZ = 2                  ' Unicode nul terminated string
  30. Const REG_DWORD = 4                      ' 32-bit number
  31.  
  32. ' Reg Create Type Values...
  33. Const REG_OPTION_NON_VOLATILE = 0       ' Key is preserved when system is rebooted
  34.  
  35. ' Reg Key Security Options...
  36. Const READ_CONTROL = &H20000
  37. Const KEY_QUERY_VALUE = &H1
  38. Const KEY_SET_VALUE = &H2
  39. Const KEY_CREATE_SUB_KEY = &H4
  40. Const KEY_ENUMERATE_SUB_KEYS = &H8
  41. Const KEY_NOTIFY = &H10
  42. Const KEY_CREATE_LINK = &H20
  43. Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
  44. Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
  45. Const KEY_EXECUTE = KEY_READ
  46. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  47.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  48.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  49.                      
  50. ' Reg Key ROOT Types...
  51. Public Const HKEY_CLASSES_ROOT = &H80000000
  52. Public Const HKEY_CURRENT_USER = &H80000001
  53. Public Const HKEY_LOCAL_MACHINE = &H80000002
  54. Public Const HKEY_USERS = &H80000003
  55. Public Const HKEY_PERFORMANCE_DATA = &H80000004
  56.  
  57. ' Return Value...
  58. Public Const ERROR_NONE = 0
  59. Public Const ERROR_BADKEY = 2
  60. Public Const ERROR_ACCESS_DENIED = 8
  61. Public Const ERROR_SUCCESS = 0
  62.  
  63. '---------------------------------------------------------------
  64. '- Registry Security Attributes TYPE...
  65. '---------------------------------------------------------------
  66. Private Type SECURITY_ATTRIBUTES
  67.     nLength As Long
  68.     lpSecurityDescriptor As Long
  69.     bInheritHandle As Boolean
  70. End Type
  71.  
  72. Public Function UpdateKeyValue(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
  73. 193 On Error GoTo ErrHandler
  74. 194     Dim rc As Long                                      ' Return Code
  75. 195     Dim hKey As Long                                    ' Handle To A Registry Key
  76. 196     Dim hDepth As Long                                  '
  77. 197     Dim lpAttr As SECURITY_ATTRIBUTES                   ' Registry Security Type
  78.     
  79. 199     lpAttr.nLength = 50                                 ' Set Security Attributes To Defaults...
  80. 200     lpAttr.lpSecurityDescriptor = 0                     ' ...
  81. 201     lpAttr.bInheritHandle = True                        ' ...
  82.  
  83.     '------------------------------------------------------------
  84.     '- Create/Open Registry Key...
  85.     '------------------------------------------------------------
  86. 206     rc = RegCreateKeyEx(KeyRoot, KeyName, _
  87.                         0, REG_SZ, _
  88.                         REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
  89.                         hKey, hDepth)                   ' Create/Open //KeyRoot//KeyName
  90.     
  91. 211     If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Errors...
  92.     
  93.     '------------------------------------------------------------
  94.     '- Create/Modify Key Value...
  95.     '------------------------------------------------------------
  96. 216     If (SubKeyValue = "") Then SubKeyValue = " "        ' A Space Is Needed For RegSetValueEx() To Work...
  97.     
  98.     ' Create/Modify Key Value
  99. 219     rc = RegSetValueEx(hKey, SubKeyName, _
  100.                        0, REG_SZ, _
  101.                        SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
  102.                        
  103. 223     If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Error
  104.     '------------------------------------------------------------
  105.     '- Close Registry Key...
  106.     '------------------------------------------------------------
  107. 227     rc = RegCloseKey(hKey)                              ' Close Key
  108.     
  109. 229     UpdateKeyValue = True                                    ' Return Success
  110. 230     Exit Function                                       ' Exit
  111. 231 CreateKeyError:
  112. 232     UpdateKeyValue = False                                   ' Set Error Return Code
  113. 233     rc = RegCloseKey(hKey)                              ' Attempt To Close Key
  114. 234     Exit Function
  115.  
  116. 236 ErrHandler: Err.Raise ProcName:=MODULE_NAME & ".UpdateKeyValue"
  117. End Function
  118.  
  119. '-------------------------------------------------------------------------------------------------
  120. 'sample usage - Debug.Print GetKeyValue(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1\CLSID", "")
  121. '-------------------------------------------------------------------------------------------------
  122. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
  123. 243 On Error GoTo ErrHandler
  124. 244     Dim i As Long                                           ' Loop Counter
  125. 245     Dim rc As Long                                          ' Return Code
  126. 246     Dim hKey As Long                                        ' Handle To An Open Registry Key
  127. 247     Dim hDepth As Long                                      '
  128. 248     Dim sKeyVal As String
  129. 249     Dim lKeyValType As Long                                 ' Data Type Of A Registry Key
  130. 250     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  131. 251     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  132.     
  133.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  134.     '------------------------------------------------------------
  135. 255     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  136.     
  137. 257     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  138.     
  139. 259     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  140. 260     KeyValSize = 1024                                       ' Mark Variable Size
  141.     
  142.     '------------------------------------------------------------
  143.     ' Retrieve Registry Key Value...
  144.     '------------------------------------------------------------
  145. 265     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  146.                          lKeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  147.                         
  148. 268     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  149.       
  150. 270     tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
  151.  
  152.     '------------------------------------------------------------
  153.     ' Determine Key Value Type For Conversion...
  154.     '------------------------------------------------------------
  155. 275     Select Case lKeyValType                                  ' Search Data Types...
  156.     Case REG_SZ, REG_EXPAND_SZ                              ' String Registry Key Data Type
  157. 277         sKeyVal = tmpVal                                     ' Copy String Value
  158. 278     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  159. 279         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  160. 280             sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  161. 281         Next
  162. 282         sKeyVal = Format$("&h" + sKeyVal)                     ' Convert Double Word To String
  163. 283     End Select
  164.     
  165. 285     GetKeyValue = sKeyVal                                   ' Return Value
  166. 286     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  167. 287     Exit Function                                           ' Exit
  168.     
  169. 289 GetKeyError:    ' Cleanup After An Error Has Occured...
  170. 290     GetKeyValue = vbNullString                              ' Set Return Val To Empty String
  171. 291     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  172. 292     Exit Function
  173.  
  174. 294 ErrHandler: Err.Raise ProcName:=MODULE_NAME & ".GetKeyValue"
  175. End Function
  176.  
  177.  
  178.