home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 June / Chip_1999-06_cd.bin / zkuste / VBasic / Data / Priklady / regedit.bas < prev    next >
BASIC Source File  |  1999-04-02  |  8KB  |  184 lines
  1. Global Const REG_SZ As Long = 1
  2. Global Const REG_DWORD As Long = 4
  3.  
  4. Global Const HKEY_CLASSES_ROOT = &H80000000
  5. Global Const HKEY_CURRENT_USER = &H80000001
  6. Global Const HKEY_LOCAL_MACHINE = &H80000002
  7. Global Const HKEY_USERS = &H80000003
  8.  
  9. Global Const ERROR_NONE = 0
  10. Global Const ERROR_BADDB = 1
  11. Global Const ERROR_BADKEY = 2
  12. Global Const ERROR_CANTOPEN = 3
  13. Global Const ERROR_CANTREAD = 4
  14. Global Const ERROR_CANTWRITE = 5
  15. Global Const ERROR_OUTOFMEMORY = 6
  16. Global Const ERROR_INVALID_PARAMETER = 7
  17. Global Const ERROR_ACCESS_DENIED = 8
  18. Global Const ERROR_INVALID_PARAMETERS = 87
  19. Global Const ERROR_NO_MORE_ITEMS = 259
  20.  
  21. Global Const KEY_ALL_ACCESS = &H3F
  22.  
  23. Global Const REG_OPTION_NON_VOLATILE = 0
  24.  
  25. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  26. 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
  27. 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
  28. 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
  29. 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
  30. 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
  31. 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
  32. 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
  33. Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
  34. Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
  35.  
  36. Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
  37. ' Sma₧e klφΦ
  38.  
  39.   Dim lRetVal As Long
  40.   Dim hKey As Long
  41.  
  42.   lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  43.   lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
  44.   RegCloseKey (hKey)
  45. End Function
  46.  
  47. Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
  48. ' Sma₧e hodnoty
  49.  
  50.   Dim lRetVal As Long
  51.   Dim hKey As Long
  52.  
  53.   lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  54.   lRetVal = RegDeleteValue(hKey, sValueName)
  55.   RegCloseKey (hKey)
  56. End Function
  57.  
  58. Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
  59.   Dim lValue As Long
  60.   Dim sValue As String
  61.  
  62.   Select Case lType
  63.     Case REG_SZ
  64.       sValue = vValue
  65.       SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
  66.     Case REG_DWORD
  67.       lValue = vValue
  68.       SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
  69.   End Select
  70. End Function
  71.  
  72. Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
  73.     Dim cch As Long
  74.     Dim lrc As Long
  75.     Dim lType As Long
  76.     Dim lValue As Long
  77.     Dim sValue As String
  78.  
  79.     On Error GoTo QueryValueExError
  80.  
  81.     lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
  82.     If lrc <> ERROR_NONE Then Error 5
  83.  
  84.     Select Case lType
  85.         Case REG_SZ:
  86.             sValue = String(cch, 0)
  87.             lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
  88.             If lrc = ERROR_NONE Then
  89.                 vValue = Left$(sValue, cch)
  90.             Else
  91.                 vValue = Empty
  92.             End If
  93.         Case REG_DWORD:
  94.             lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
  95.             If lrc = ERROR_NONE Then vValue = lValue
  96.         Case Else
  97.             lrc = -1
  98.     End Select
  99.  
  100. QueryValueExExit:
  101.  
  102.     QueryValueEx = lrc
  103.     Exit Function
  104.  
  105. QueryValueExError:
  106.  
  107.     Resume QueryValueExExit
  108.  
  109. End Function
  110.  
  111. Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
  112. ' vytvo°φ nov² klφΦ
  113.  
  114.     Dim hNewKey As Long         'handle to the new key
  115.     Dim lRetVal As Long         'result of the RegCreateKeyEx function
  116.     
  117.     lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
  118.     RegCloseKey (hNewKey)
  119. End Function
  120.  
  121. Do formulß°e: (P°φklad pou₧itφ)
  122.  
  123. Sub Main()
  124.     'Examples of each function:
  125.     'CreateNewKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"
  126.     'SetKeyValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test", "Testing, Testing", REG_SZ
  127.     'MsgBox QueryValue(HKEY_CURRENT_USER, "TestKey\SubKey1", "Test")
  128.     'DeleteKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"
  129.     'DeleteValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test"
  130. End Sub
  131.  
  132. Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
  133. ' Description:
  134. '   This Function will set the data field of a value
  135. '
  136. ' Syntax:
  137. '   QueryValue Location, KeyName, ValueName, ValueSetting, ValueType
  138. '
  139. '   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
  140. '   , HKEY_USERS
  141. '
  142. '   KeyName is the key that the value is under (example: "Key1\SubKey1")
  143. '
  144. '   ValueName is the name of the value you want create, or set the value of (example: "ValueTest")
  145. '
  146. '   ValueSetting is what you want the value to equal
  147. '
  148. '   ValueType must equal either REG_SZ (a string) Or REG_DWORD (an integer)
  149.  
  150.        Dim lRetVal As Long         'result of the SetValueEx function
  151.        Dim hKey As Long         'handle of open key
  152.  
  153.        'open the specified key
  154.  
  155.        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  156.        lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
  157.        RegCloseKey (hKey)
  158.  
  159. End Function
  160.  
  161. Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
  162. ' Description:
  163. '   This Function will return the data field of a value
  164. '
  165. ' Syntax:
  166. '   Variable = QueryValue(Location, KeyName, ValueName)
  167. '
  168. '   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
  169. '   , HKEY_USERS
  170. '
  171. '   KeyName is the key that the value is under (example: "Software\Microsoft\Windows\CurrentVersion\Explorer")
  172. '
  173. '   ValueName is the name of the value you want to access (example: "link")
  174.  
  175.        Dim lRetVal As Long         'result of the API functions
  176.        Dim hKey As Long         'handle of opened key
  177.        Dim vValue As Variant      'setting of queried value
  178.  
  179.        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  180.        lRetVal = QueryValueEx(hKey, sValueName, vValue)
  181.        'MsgBox vValue
  182.        QueryValue = vValue
  183.        RegCloseKey (hKey)
  184. End Function