本页主题: 取到注册表中列在右边的所有项 打印 | 加为IE收藏 | 复制链接 | 收藏主题 | 上一主题 | 下一主题

a6842402
张西I Love You!
级别: 荣誉会员


精华: 1
发帖: 39
威望: 67 点
VB币: 135 个
贡献值: 2 点
在线时间:6(小时)
注册时间:2008-05-08
最后登录:2008-10-05

 取到注册表中列在右边的所有项

管理提醒:
本帖被 now1000 设置为精华(2008-07-18)
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
我不是一个随便的人,我随便起来不是人!
Posted: 2008-06-24 12:31 | [楼 主]
帖子浏览记录 版块浏览记录
VB家园 » 『API资料专区』



中华人民共和国信息产业部许可证编号:粤ICP备08023639号 
Powered by PHPWind v6.0 Certificate Code © 2003-07 PHPWind.com Corporation