建一个模块先:
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Const ERROR_SUCCESS = 0&
窗体上加
list1
list2
label1
label2
command1
窗体上的代码:
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