VB 遍历注册表代码。

转帖 来自huangzhieling

----------------------------------------------------------

 添加一下控件：

2   个list  
  2   个label  
  1   个command  

----------------------------------

Private Type FILETIME
                  dwLowDateTime   As Long
                  dwHighDateTime   As Long
  End Type
   
  Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, _
  ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, _
  ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
   
  Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
   
  Private Const HKEY_CLASSES_ROOT = &H80000000
 Private Const HKEY_CURRENT_CONFIG = &H80000005
  Private Const HKEY_CURRENT_USER = &H80000001
  Private Const HKEY_DYN_DATA = &H80000006
  Private Const HKEY_LOCAL_MACHINE = &H80000002
  Private Const HKEY_USERS = &H80000003
   
  Private Const ERROR_NO_MORE_ITEMS = 259&
 Private Const ERROR_SUCCESS = 0&
   

  Public Sub FindKeys(hKey As Long, SubKey As String)
  Dim phkRet     As Long
  Dim Index     As Long, Name       As String, lName       As Long, lReserved       As Long, Class       As String, lClass       As Long, LWT       As FILETIME
  Dim lRet     As Long
  Dim Keys     As String, TempKeys       As String
  Static Num     As Long
  lReserved = 0&
  Index = 0
  lRet = RegOpenKey(hKey, SubKey, phkRet)
  If lRet = ERROR_SUCCESS Then
    Do
        DoEvents
        Name = String(255, Chr(0))
        lName = Len(Name)
        lRet = RegEnumKeyEx(phkRet, Index, Name, lName, lReserved, Class, lClass, LWT)
        If lRet = ERROR_SUCCESS Then
          'If   SubKey   =   ""   Then
            'Keys   =   Name
          'Else
            Keys = SubKey & "/" & Name
          'End   If
          'TempKeys   =   Keys
          List1.AddItem Keys
          List2.AddItem Keys
          Label1.Caption = Keys
          Num = Num + 1
          Label2.Caption = Num
        Else
          Exit Do
        End If
        Index = Index + 1
        Loop While lRet = ERROR_SUCCESS
  End If
   
  Call RegCloseKey(phkRet)
  End Sub
   
  Private Sub Command1_Click()
  'List1.Visible   =   False
  'List2.Visible   =   False
  List1.Clear
  List2.Clear
  Dim OT     As Single
  OT = Timer
  List2.List(0) = ""
  Dim hKey     As Long
  Dim SubKey     As String
  hKey = HKEY_LOCAL_MACHINE
 
   
  While List2.ListCount <> 0
    DoEvents
    If Left(List2.List(0), 1) <> "/" Then
      SubKey = List2.List(0)
    Else
      SubKey = Right(List2.List(0), Len(List2.List(0)) - 1)
    End If
    Call FindKeys(hKey, SubKey)
    List2.RemoveItem 0
  Wend
  Label1.Caption = "耗时：" & Timer - OT & "   秒"
  Label2.Caption = "共计：" & List1.ListCount & "   项"
  'List1.Visible   =   True
  'List2.Visible   =   True
  End Sub
   
  Private Sub Form_Unload(Cancel As Integer)
  End
  End Sub

-----------------------------------------------------------------------------------------------------------

遍历注册表，可以直接运行成功的代码。