home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD14473232001.psc / Reg.bas < prev   
Encoding:
BASIC Source File  |  2001-02-03  |  4.4 KB  |  120 lines
  1. Attribute VB_Name = "Reg"
  2. Option Explicit
  3. 'Only small comments here and there as you might be knowing all these
  4.  
  5. Public Const HKEY_CLASSES_ROOT = &H80000000
  6. Public Const HKEY_CURRENT_USER = &H80000001
  7. Public Const HKEY_LOCAL_MACHINE = &H80000002
  8. Public Const HKEY_USERS = &H80000003
  9. Public Const HKEY_PERFORMANCE_DATA = &H80000004
  10. Public Const HKEY_CURRENT_CONFIG = &H80000005
  11. Public Const HKEY_DYN_DATA = &H80000006
  12. Public Const REG_SZ = 1                         ' Unicode nul terminated string
  13. Public Const REG_BINARY = 3                     ' Free form binary
  14. Public Const REG_DWORD = 4                      ' 32-bit number
  15. Public Const ERROR_SUCCESS = 0&
  16.  
  17. Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  18. Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  19. Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  20. Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  21. Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
  22.  
  23. Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
  24. Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
  25.  
  26. Public 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
  27. Public 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
  28.  
  29. Public Sub CreateKey(hKey As Long, strPath As String)
  30. Dim hCurKey As Long
  31. Dim lRegResult As Long
  32.  
  33. lRegResult = RegCreateKey(hKey, strPath, hCurKey)
  34.  
  35. If lRegResult <> ERROR_SUCCESS Then
  36.   'a problem ?
  37. End If
  38.  
  39. lRegResult = RegCloseKey(hCurKey)
  40.  
  41. End Sub
  42.  
  43. Public Sub DeleteKey(ByVal hKey As Long, ByVal strPath As String)
  44. Dim lRegResult As Long
  45.  
  46. lRegResult = RegDeleteKey(hKey, strPath)
  47.  
  48. End Sub
  49.  
  50. Public Sub DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
  51. Dim hCurKey As Long
  52. Dim lRegResult As Long
  53.  
  54. lRegResult = RegOpenKey(hKey, strPath, hCurKey)
  55.  
  56. lRegResult = RegDeleteValue(hCurKey, strValue)
  57.  
  58. lRegResult = RegCloseKey(hCurKey)
  59.  
  60. End Sub
  61.  
  62. Public Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
  63. Dim hCurKey As Long
  64. Dim lValueType As Long
  65. Dim strBuffer As String
  66. Dim lDataBufferSize As Long
  67. Dim intZeroPos As Integer
  68. Dim lRegResult As Long
  69.  
  70. ' Set up default value
  71. If Not IsEmpty(Default) Then
  72.   GetSettingString = Default
  73. Else
  74.   GetSettingString = ""
  75. End If
  76.  
  77. ' Open the key and get length of string
  78. lRegResult = RegOpenKey(hKey, strPath, hCurKey)
  79. lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
  80.  
  81. If lRegResult = ERROR_SUCCESS Then
  82.  
  83.   If lValueType = REG_SZ Then
  84.     ' initialise string buffer and retrieve string
  85.     strBuffer = String(lDataBufferSize, " ")
  86.     lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
  87.     
  88.     ' format string
  89.     intZeroPos = InStr(strBuffer, Chr$(0))
  90.     If intZeroPos > 0 Then
  91.       GetSettingString = Left$(strBuffer, intZeroPos - 1)
  92.     Else
  93.       GetSettingString = strBuffer
  94.     End If
  95.  
  96.   End If
  97.  
  98. Else
  99.  'im..y!
  100. End If
  101.  
  102. lRegResult = RegCloseKey(hCurKey)
  103. End Function
  104.  
  105. Public Sub SaveSettingString(hKey As Long, strPath As String, strValue As String, strData As String)
  106. Dim hCurKey As Long
  107. Dim lRegResult As Long
  108.  
  109. lRegResult = RegCreateKey(hKey, strPath, hCurKey)
  110.  
  111. lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
  112.  
  113. If lRegResult <> ERROR_SUCCESS Then
  114.   'problem :-( .Why? No way!
  115. End If
  116.  
  117. lRegResult = RegCloseKey(hCurKey)
  118. End Sub
  119.  
  120.