home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / ENTRPRIS / POOLMGR / REGUTIL.BAS < prev   
Encoding:
BASIC Source File  |  1996-11-23  |  5.4 KB  |  163 lines
  1. Attribute VB_Name = "Module2"
  2. 'Attribute VB_Name = "RegUtil"
  3. Option Explicit
  4.  
  5. #If RA_WIN32 Then
  6.   Global Const HKEY_CLASSES_ROOT = &H80000000
  7. #Else
  8.   Global Const HKEY_CLASSES_ROOT = 1
  9. #End If
  10. Global Const REG_SZ = 1
  11.  
  12. Global Const ERROR_NONE = 0
  13. Global Const ERROR_BADDB = 1
  14. Global Const ERROR_BADKEY = 2
  15. Global Const ERROR_CANTOPEN = 3
  16. Global Const ERROR_CANTREAD = 4
  17. Global Const ERROR_CANTWRITE = 5
  18. Global Const ERROR_OUTOFMEMORY = 6
  19. Global Const ERROR_INVALID_PARAMETER = 7
  20. Global Const ERROR_ACCESS_DENIED = 8
  21. Global Const ERROR_NO_MORE_ITEMS = 259
  22.  
  23. #If RA_WIN32 Then
  24.   Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
  25.   Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal szSubKey As String, hkeyResult As Long) As Long
  26.   Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal szSubKey As String) As Long
  27.   Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hkey As Long, ByVal iSubKey As Long, ByVal szBuffer As String, ByVal cbBuf As Long) As Long
  28.   Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal szSubKey As String, hkeyResult As Long) As Long
  29.   Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hkey As Long, ByVal szSubKey As String, ByVal szValue As String, chValue As Long) As Long
  30.   Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hkey As Long, ByVal szSubKey As String, ByVal fdwType As Long, ByVal lpszValue As String, ByVal cb As Long) As Long
  31. #Else
  32.   Declare Function RegCloseKey Lib "shell.dll" (ByVal hkey As Long) As Long
  33.   Declare Function RegCreateKey Lib "shell.dll" (ByVal hkey As Long, ByVal szSubKey As String, hkeyResult As Long) As Long
  34.   Declare Function RegDeleteKey Lib "shell.dll" (ByVal hkey As Long, ByVal szSubKey As String) As Long
  35.   Declare Function RegEnumKey Lib "shell.dll" (ByVal hkey As Long, ByVal iSubKey As Long, ByVal szBuffer As String, ByVal cbBuf As Long) As Long
  36.   Declare Function RegOpenKey Lib "shell.dll" (ByVal hkey As Long, ByVal szSubKey As String, hkeyResult As Long) As Long
  37.   Declare Function RegQueryValue Lib "shell.dll" (ByVal hkey As Long, ByVal szSubKey As String, ByVal szValue As String, chValue As Long) As Long
  38.   Declare Function RegSetValue Lib "shell.dll" (ByVal hkey As Long, ByVal szSubKey As String, ByVal fdwType As Long, ByVal lpszValue As String, ByVal cb As Long) As Long
  39. #End If
  40.  
  41. Function DeleteAllKeys() As Long
  42.    Dim lRegErr As Long
  43.    Dim sKey As String
  44.  
  45.    Do
  46.      lRegErr = EnumKey(HKEY_CLASSES_ROOT, 0, sKey)
  47.      If lRegErr = ERROR_BADKEY Or lRegErr = ERROR_ACCESS_DENIED Or lRegErr = ERROR_NO_MORE_ITEMS Then
  48.        lRegErr = ERROR_NONE
  49.        Exit Do
  50.      ElseIf lRegErr <> ERROR_NONE Then
  51.        Exit Do
  52.      End If
  53.      lRegErr = RegDeleteKey(HKEY_CLASSES_ROOT, sKey)
  54.      If lRegErr <> ERROR_NONE Then
  55.        Exit Do
  56.      End If
  57.    Loop
  58.  
  59.    DeleteAllKeys = lRegErr
  60.  
  61. End Function
  62.  
  63. Function EnumKey(ByVal hkey As Long, ByVal lSubKey As Long, rsSubKey As String) As Long
  64.   Const nBufMax = 1024
  65.  
  66.   Static sResultBuf As String * nBufMax
  67.   Dim nResultLen As Integer
  68.   Dim lRegErr As Long
  69.   
  70.   lRegErr = RegEnumKey(hkey, lSubKey, sResultBuf, nBufMax)
  71.  
  72.   If lRegErr = 0 Then
  73.     nResultLen = InStr(sResultBuf, Chr$(0))
  74.     If nResultLen <> 0 Then
  75.       rsSubKey = Left$(sResultBuf, nResultLen - 1)
  76.     Else
  77.       rsSubKey = sResultBuf
  78.     End If
  79.   Else
  80.     rsSubKey = ""
  81.   End If
  82.  
  83.   EnumKey = lRegErr
  84. End Function
  85.  
  86. Function QueryValue(ByVal hkey As Long, ByVal sSubKey As String, rsValue As String) As Long
  87.   Const nBufMax = 1024
  88.  
  89.   Static sResultBuf As String * nBufMax
  90.   Dim nResultLen As Long
  91.   Dim lRegErr As Long
  92.  
  93.   nResultLen = nBufMax
  94.   lRegErr = RegQueryValue(hkey, sSubKey, sResultBuf, nResultLen)
  95.  
  96.   If lRegErr = 0 Then
  97.     rsValue = Left$(sResultBuf, nResultLen - 1)
  98.   Else
  99.     rsValue = ""
  100.   End If
  101.  
  102.   QueryValue = lRegErr
  103. End Function
  104.  
  105. Function SetValue(ByVal hkey As Long, rsSubKey As String, rsValue As String) As Long
  106.  
  107.   SetValue = RegSetValue(hkey, rsSubKey, REG_SZ, rsValue, Len(rsValue))
  108.  
  109. End Function
  110.  
  111. ' Write all keys at a level to the specified file
  112. ' handle as well as all subkeys.
  113. '
  114. ' rsRoot is the string representation of the current
  115. ' level to use.
  116. Sub WriteKeys(rhkey As Long, fh As Integer, rsRoot As String, rbIHaveSubKeys As Integer)
  117.   Dim i As Integer
  118.   Dim sKey As String
  119.   Dim sSubKey As String
  120.   Dim lRegErr As Long
  121.   Dim lhkSubKey As Long
  122.   Dim sValue As String
  123.   Dim bHasSubKeys As Integer
  124.  
  125.   i = 0
  126.   rbIHaveSubKeys = False
  127.   Do
  128.     lRegErr = EnumKey(rhkey, i, sSubKey)
  129.     If lRegErr = ERROR_BADKEY Or lRegErr = ERROR_ACCESS_DENIED Or lRegErr = ERROR_NO_MORE_ITEMS Then
  130.       Exit Do
  131.     ElseIf lRegErr <> ERROR_NONE Then
  132.       Exit Sub
  133.     End If
  134.  
  135.     rbIHaveSubKeys = True
  136.  
  137.     lRegErr = RegOpenKey(rhkey, sSubKey, lhkSubKey)
  138.     If lRegErr <> ERROR_NONE Then
  139.       Exit Sub
  140.     End If
  141.  
  142.     sKey = rsRoot + "\" + sSubKey
  143.  
  144.     WriteKeys lhkSubKey, fh, sKey, bHasSubKeys
  145.  
  146.     lRegErr = QueryValue(lhkSubKey, "", sValue)
  147.     If lRegErr = ERROR_NONE Then
  148.       If Len(sValue) <> 0 Then
  149.         Print #fh, sKey; " = "; sValue
  150.       ElseIf Not bHasSubKeys Then
  151.         Print #fh, sKey
  152.       End If
  153.     Else
  154.       lRegErr = RegCloseKey(lhkSubKey)
  155.       Exit Sub
  156.     End If
  157.  
  158.     lRegErr = RegCloseKey(lhkSubKey)
  159.     i = i + 1
  160.   Loop
  161. End Sub
  162.  
  163.