home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Updated-_V1986874132006.psc / clsLBench.cls < prev    next >
Text File  |  2006-01-06  |  6KB  |  156 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsLBench"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16.  
  17. Private Const ERROR_NONE                   As Long = &H0
  18. Private Const ERROR_BADDB                  As Long = &H1
  19. Private Const ERROR_BADKEY                 As Long = &H2
  20. Private Const ERROR_CANTOPEN               As Long = &H3
  21. Private Const ERROR_CANTREAD               As Long = &H4
  22. Private Const ERROR_CANTWRITE              As Long = &H5
  23. Private Const ERROR_OUTOFMEMORY            As Long = &H6
  24. Private Const ERROR_ARENA_TRASHED          As Long = &H7
  25. Private Const ERROR_ACCESS_DENIED          As Long = &H8
  26. Private Const ERROR_INVALID_PARAMETERS     As Long = &H57
  27. Private Const ERROR_MORE_DATA              As Long = &HEA
  28. Private Const ERROR_NO_MORE_ITEMS          As Long = &H103
  29.  
  30. '//access paramaters
  31. Private Const KEY_ALL_ACCESS               As Long = &HF003F
  32. Private Const KEY_CREATE_LINK              As Long = &H20
  33. Private Const KEY_CREATE_SUB_KEY           As Long = &H4
  34. Private Const KEY_ENUMERATE_SUB_KEYS       As Long = &H8
  35. Private Const KEY_EXECUTE                  As Long = &H20019
  36. Private Const KEY_NOTIFY                   As Long = &H10
  37. Private Const KEY_QUERY_VALUE              As Long = &H1
  38. Private Const KEY_READ                     As Long = &H20019
  39. Private Const KEY_SET_VALUE                As Long = &H2
  40. Private Const KEY_WRITE                    As Long = &H20006
  41. Private Const REG_OPTION_NON_VOLATILE      As Long = &H0
  42. Private Const REG_ERR_OK                   As Long = &H0
  43. Private Const REG_ERR_NOT_EXIST            As Long = &H1
  44. Private Const REG_ERR_NOT_STRING           As Long = &H2
  45. Private Const REG_ERR_NOT_DWORD            As Long = &H4
  46.  
  47. '//time structure
  48. Private Type FILETIME
  49.     dwLowDateTime                              As Long
  50.     dwHighDateTime                             As Long
  51. End Type
  52.  
  53. '//security structure
  54. Private Type SECURITY_ATTRIBUTES
  55.     nLength                                    As Long
  56.     lpSecurityDescriptor                       As Long
  57.     bInheritHandle                             As Boolean
  58. End Type
  59.  
  60. Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, _
  61.                                                                                 ByVal lpSubKey As String, _
  62.                                                                                 ByVal ulOptions As Long, _
  63.                                                                                 ByVal samDesired As Long, _
  64.                                                                                 phkResult As Long) As Long
  65.                                                                                 
  66. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  67.  
  68. Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, _
  69.                                                                                 ByVal dwIndex As Long, _
  70.                                                                                 ByVal lpName As String, _
  71.                                                                                 lpcbName As Long, _
  72.                                                                                 lpReserved As Long, _
  73.                                                                                 ByVal lpClass As String, _
  74.                                                                                 lpcbClass As Long, _
  75.                                                                                 lpftLastWriteTime As FILETIME) As Long
  76.  
  77. Private cLKeyList As New Collection
  78.  
  79. Private Function Lib_List_Keys(ByVal lHKey As HKEY_Type, _
  80.                                ByVal SubKey As String) As Collection
  81.  
  82. '//list all keys and add to collection
  83. Dim KeyName   As String
  84. Dim keylen    As Long
  85. Dim classname As String
  86. Dim classlen  As Long
  87. Dim lastwrite As FILETIME
  88. Dim hKey      As Long
  89. Dim RetVal    As Long
  90. Dim Index     As Long
  91. Dim cKeyList  As New Collection
  92.  
  93. On Error GoTo Handler
  94.  
  95.     Set cKeyList = New Collection
  96.     '//open key
  97.     RetVal = RegOpenKeyEx(lHKey, SubKey, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
  98.     If Not RetVal = ERROR_NONE Then
  99.         Set cKeyList = Nothing
  100.         Exit Function
  101.     End If
  102.     Index = 0
  103.     '//loop through keys and add to collection
  104.     Do
  105.         KeyName = Space$(255)
  106.         keylen = 255
  107.         classname = Space$(255)
  108.         classlen = 255
  109.         RetVal = RegEnumKeyEx(hKey, Index, KeyName, keylen, ByVal 0, classname, classlen, lastwrite)
  110.         If RetVal = ERROR_NONE Then
  111.             KeyName = Left$(KeyName, keylen)
  112.             cKeyList.Add KeyName
  113.         End If
  114.         Index = Index + 1
  115.     Loop Until Not RetVal = 0
  116.     '//close
  117.     Set Lib_List_Keys = cKeyList
  118.     Set cKeyList = Nothing
  119.  
  120. Handler:
  121. RetVal = RegCloseKey(hKey)
  122.  
  123. End Function
  124.  
  125. Public Function Lib_Recurse_Keys(ByVal lHKey As HKEY_Type, _
  126.                             ByVal sSubKey As String) As Collection
  127.  
  128. Dim cKey     As Variant
  129.  
  130. On Error GoTo Handler
  131.  
  132.     For Each cKey In Lib_List_Keys(lHKey, sSubKey)
  133.         If Not IsEmpty(cKey) Then
  134.             cLKeyList.Add sSubKey & Chr(92) & cKey
  135.             Lib_Recurse_Keys lHKey, sSubKey & Chr(92) & cKey
  136.         End If
  137.     Next cKey
  138.  
  139. Set Lib_Recurse_Keys = cLKeyList
  140. Handler:
  141. On Error GoTo 0
  142.  
  143. End Function
  144.  
  145. Private Sub Class_Initialize()
  146.     Set cLKeyList = New Collection
  147. End Sub
  148.  
  149. Private Sub Class_Terminate()
  150.     Set cLKeyList = Nothing
  151. End Sub
  152.  
  153.  
  154.  
  155.  
  156.