home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD103621022000.psc / REG_VIEW.BAS < prev    next >
Encoding:
BASIC Source File  |  2000-08-10  |  7.2 KB  |  249 lines
  1. Attribute VB_Name = "Registry_Viewing"
  2. ' Registry viewing
  3. '   Notes:
  4. '
  5. '
  6. '   Bugs:
  7. '
  8. '
  9. Option Explicit
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20. ' Loads a sub-tree into the TreeView control pTree
  21. '
  22. '   Algorithm:
  23. ' The traditional recursive descent, but flattened into a non-recursive
  24. ' implementation (easier to implement with VB).
  25. ' Arrays are used to simulate the call stack of a recursive implementation
  26. '
  27. ' A state machine is used to control execution of the algorithm, and the
  28. ' switch between logging values and logging keys
  29. '
  30. '   Enhancements:
  31. ' Show icons to distinguish the key nodes from values
  32. '
  33. '   Notes:
  34. ' Values are prefixed with a "v" before being added to the node collection,
  35. ' for otherwise there will be a RTE if a key & a value with identical names are encountered
  36. ' It would be neater if this were done with a trailing "\" instead
  37. '
  38. Public Sub ViewRegistrySubTree(ByVal pRootKey As Long, pInitialKey$, pTree As TreeView)
  39.  
  40.  
  41.  
  42. Dim hKey As Long
  43. Dim hSubKey As Long
  44.  
  45. ' Fragments of keys
  46. Dim lpSubkeyName As String
  47. Dim lpValueName As String
  48. Dim lpValue As String
  49.  
  50. ' Entire keys
  51. Dim lRootKey$
  52.  
  53.  
  54.  
  55. Dim llRetVal As Long
  56.  
  57. Dim lpType As Long
  58.  
  59. Dim lcolDataSources As New Collection
  60. Dim lobjDataSource
  61. Dim nodX As Node
  62.  
  63. Const lMAX_DESCENT = 7
  64.  
  65. ' Arrays for doing the recursive descent
  66. Dim lDescentLevel%
  67. Dim lLastDescentLevel%
  68. Dim lDescendingIndex(0 To lMAX_DESCENT) As Long
  69. Dim lDescendingKey$(0 To lMAX_DESCENT)
  70. Dim lDescendingKeyLong$(0 To lMAX_DESCENT)
  71. Dim lDescendinghKey(0 To lMAX_DESCENT) As Long
  72. Dim lDescendingScanState%(0 To lMAX_DESCENT)
  73. Dim lScanState%
  74.  
  75. Dim i%
  76. Dim lWork$
  77.  
  78.  
  79. Const lSTATE_OPEN_KEY = 1
  80. Const lSTATE_ITERATE_VALUES = 2
  81. Const lSTATE_ITERATE_KEYS = 3
  82. Const lSTATE_PUSH_KEY = 4
  83. Const lSTATE_POP_KEY = 5
  84. Const lSTATE_FINISHED = 999
  85.  
  86. Dim lKeyCount As Long
  87.  
  88. Dim lMaxExpandLevel%
  89.  
  90.  
  91.   On Error GoTo ViewRegistrySubTree_ERH
  92.   pTree.Nodes.Clear
  93.   DoEvents
  94.   
  95.   ' At first we'll expand 1,2 & >=4
  96.   ' Later we'll turn this to just 1 & >=4
  97.   lMaxExpandLevel% = 2
  98.   
  99.   lLastDescentLevel% = 0
  100.   lDescendinghKey(lLastDescentLevel%) = pRootKey
  101.   lDescendingKey$(0) = ""
  102.   lDescendingKeyLong$(0) = "\"
  103.   
  104.   lDescentLevel% = lLastDescentLevel% + 1
  105.   lDescendingKey$(lDescentLevel%) = pInitialKey$
  106.   lDescendingKeyLong$(lDescentLevel%) = "\" & lDescendingKey$(lDescentLevel%)
  107.   lDescendingScanState%(lDescentLevel%) = 0
  108.   lDescendingIndex(lDescentLevel%) = 0
  109.   
  110.   lScanState% = lSTATE_OPEN_KEY
  111.   lKeyCount = 0
  112.   
  113.   
  114.   ' Loop
  115.   Do While (llRetVal = ERROR_SUCCESS) And (lScanState% <> lSTATE_FINISHED) And (lDescentLevel% >= 0) And (lDescentLevel% <= lMAX_DESCENT)
  116.   
  117.     Select Case lScanState%
  118.     
  119.     Case lSTATE_OPEN_KEY
  120.       llRetVal = RegOpenKey(lDescendinghKey(lLastDescentLevel%), lDescendingKey$(lDescentLevel%), KEY_READ, lDescendinghKey(lDescentLevel%))
  121.       
  122.       If llRetVal = ERROR_SUCCESS Then
  123.         lKeyCount = lKeyCount + 1
  124.         lDescendingKeyLong$(lDescentLevel%) = IIf((lDescendingKeyLong$(lLastDescentLevel%) = "\"), "", lDescendingKeyLong$(lLastDescentLevel%)) & "\" & lDescendingKey$(lDescentLevel%)
  125.     
  126.         If lDescentLevel% = 1 Then
  127. '          Debug.Print "Adding First Key <>", "<"; lDescendingKeyLong$(lDescentLevel%); ">", "<"; lDescendingKey$(lDescentLevel%); ">"
  128.           Set nodX = pTree.Nodes.Add(, , lDescendingKeyLong$(lDescentLevel%), lDescendingKey$(lDescentLevel%), tvwTextOnly)
  129.         Else
  130. '          Debug.Print "Adding Key <"; lDescendingKeyLong$(lLastDescentLevel%); ">", "<"; lDescendingKeyLong$(lDescentLevel%); ">", "<"; lDescendingKey$(lDescentLevel%); ">"
  131.           Set nodX = pTree.Nodes.Add(lDescendingKeyLong$(lLastDescentLevel%), tvwChild, lDescendingKeyLong$(lDescentLevel%), lDescendingKey$(lDescentLevel%), tvwTextOnly)
  132.         End If
  133.         nodX.Expanded = (lDescentLevel% > 3) Or (lDescentLevel% <= lMaxExpandLevel%)
  134.         If (pTree.Nodes.Count > 300) Then lMaxExpandLevel% = 2
  135.         If (lDescentLevel% < 4) Or ((lKeyCount Mod 32) = 0) Then DoEvents
  136.         
  137.         lScanState% = lSTATE_ITERATE_VALUES
  138.         lDescendingIndex(lDescentLevel%) = 0
  139.       Else
  140.         lScanState% = lSTATE_FINISHED
  141.       End If
  142.       
  143.       
  144.     Case lSTATE_ITERATE_VALUES
  145.       llRetVal = RegEnumValue(lDescendinghKey(lDescentLevel%), lDescendingIndex(lDescentLevel%), lpValueName, lpType, lpValue)
  146.     
  147.       Select Case llRetVal
  148.       Case ERROR_SUCCESS
  149.         Select Case lpType
  150.         Case 1
  151.         
  152.         Case Else
  153.         End Select
  154. '          Debug.Print "Adding Value <"; lDescendingKeyLong$(lDescentLevel%); ">", "<"; lDescendingKeyLong$(lDescentLevel%) & "\" & lpValueName; ">", "<"; lpValueName & "=" & lpValue; ">"
  155.           Set nodX = pTree.Nodes.Add(lDescendingKeyLong$(lDescentLevel%), tvwChild, "v" & lDescendingKeyLong$(lDescentLevel%) & "\" & lpValueName, lpValueName & "=" & lpValue, tvwTextOnly) ' LoadPicture("D:\vb4-32\icons\writing\note10.ico")
  156.           nodX.Expanded = True
  157.         lDescendingIndex(lDescentLevel%) = lDescendingIndex(lDescentLevel%) + 1
  158.       
  159.       Case 259
  160.         llRetVal = ERROR_SUCCESS
  161.         lScanState% = lSTATE_ITERATE_KEYS
  162.         lDescendingIndex(lDescentLevel%) = 0
  163.       
  164.       Case Else
  165.         lScanState% = lSTATE_FINISHED
  166.         
  167.       End Select
  168.     
  169.     
  170.     Case lSTATE_ITERATE_KEYS
  171.       llRetVal = RegEnumKey(lDescendinghKey(lDescentLevel%), lDescendingIndex(lDescentLevel%), lpValueName)
  172.     
  173.       Select Case llRetVal
  174.       Case ERROR_SUCCESS
  175.         lScanState% = lSTATE_PUSH_KEY
  176.       
  177.       Case 259
  178.         llRetVal = ERROR_SUCCESS
  179.         lScanState% = lSTATE_POP_KEY
  180.       
  181.       Case Else
  182.         lScanState% = lSTATE_FINISHED
  183.         
  184.       End Select
  185.     
  186.         
  187.     Case lSTATE_PUSH_KEY
  188.       ' Going down
  189.       lLastDescentLevel% = lDescentLevel%
  190.       lDescentLevel% = lDescentLevel% + 1
  191.       
  192.       lDescendingKey$(lDescentLevel%) = lpValueName
  193.         
  194.       If lDescentLevel% >= lMAX_DESCENT Then
  195.         lScanState% = lSTATE_POP_KEY  ' Too far down
  196.       Else
  197.         lScanState% = lSTATE_OPEN_KEY
  198.       End If
  199.       
  200.       
  201.     Case lSTATE_POP_KEY
  202.       ' Going up
  203.       lDescentLevel% = lDescentLevel% - 1
  204.       lLastDescentLevel% = lDescentLevel% - 1
  205.       
  206.       If lDescentLevel% >= 1 Then
  207.         lDescendingIndex(lDescentLevel%) = lDescendingIndex(lDescentLevel%) + 1
  208.         lScanState% = lSTATE_ITERATE_KEYS
  209.       Else
  210.         lScanState% = lSTATE_FINISHED
  211.       End If
  212.       
  213.     Case Else
  214.     End Select
  215.   Loop
  216.   
  217.   
  218.   ' Make the first node visible
  219.   If (pTree.Nodes.Count > 0) Then pTree.Nodes(1).EnsureVisible
  220.   
  221. '  Debug.Print "Key count = "; lKeyCount
  222.   
  223.   
  224.   Exit Sub
  225.   
  226.   
  227.   
  228. ViewRegistrySubTree_ERH:
  229.   
  230. Dim objNode
  231.   
  232.   Debug.Print
  233.   
  234. '  For Each objNode In pTree.Nodes
  235. '    Debug.Print objNode.Index, "<"; objNode.Key; ">", "<"; objNode.Text; ">"
  236. '  Next objNode
  237.   Debug.Print "**************************************"
  238.   Debug.Print Err, Err.Description
  239.   Debug.Print "lDescentLevel% = "; lDescentLevel%
  240.   Debug.Print "Key count = "; lKeyCount
  241.   Debug.Print lDescendingKeyLong$(lDescentLevel%), "v" & lDescendingKeyLong$(lDescentLevel%) & "\" & lpValueName, lpValueName & "=" & lpValue
  242.   Debug.Print
  243.   
  244.   Exit Sub
  245. End Sub
  246.  
  247.  
  248.  
  249.