如何遍历注册表指定项下有多小键？？？/

Question

项
HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM\
我是要得到机器有多小个串口。高手帮忙。

Answer 1

可以用GetAllSetting函数，具体没用过，我想他返回所有的值，应该可以得到有几个吧
你查一下帮助

Answer 2

是不是枚举
HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM\
子项下所有的值哦?
具体实现代码:
新建立一个工程.添加两个TextBox控件(text1,text2)Text1属性设置为MultiLine=True
,ScrollBars=3-Both
添加两个label控件(Label1,Label2)
一个listBox控件(list1)
两个CommandButton控件(Command1,Command2)然后在窗体中写入如下代码:
Option Explicit
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegEnumValueAsAny Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize 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_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_MULTI_SZ = 7Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
Dim lKey As String
Private Sub MultiStringToStringArray(S As String, S2() As String)
Dim count As Long
Dim pos As Long
Dim pos2 As Long
Dim idx As Long
pos = InStr(S, Chr(0))
While pos > 0
count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
count = count - 1
ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End SubPrivate Sub Command1_Click()
Dim hkey As Long
Dim ret As Long
Dim lenData As Long
Dim typeData As Long
Dim Name As String
Dim lenName As Long
Dim idx As Long
Dim j As Long
Dim tName As String * 256
Dim hKey2 As Long
Dim cKey As Long
Dim sKey As String
Dim lenS As Long
Select Case lKey
Case "HKEY_CLASSES_ROOT"
cKey = &H80000000
Case "HKEY_CURRENT_USER"
cKey = &H80000001
Case "HKEY_LOCAL_MACHINE"
cKey = &H80000002
Case "HKEY_USERS"
cKey = &H80000003
Case "HKEY_CURRENT_CONFIG"
cKey = &H80000005
Case ""
MsgBox "请选择控制项"
Exit Sub
End Select
If Text2.Text = "" Then
MsgBox "请输入子项"
Exit Sub
End If
sKey = Text2.Text
ret = RegOpenKeyEx(cKey, sKey, 0, KEY_ALL_ACCESS, hkey)
If ret <> 0 Then Exit Sub
ret = 0
idx = 0
While ret = 0
lenName = 256
ret = RegEnumValueAsAny(hkey, idx, tName, lenName, ByVal 0, typeData, ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hkey
Exit Sub
End If
Name = String(lenName + 1, Chr(0))
lenName = Len(Name)
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegEnumValueAsAny hkey, idx, Name, lenName, ByVal 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = Left(S, InStr(S, Chr(0)) - 1)
Text1.SelText = IIf(lenName = 0, "(默认)", Left(Name, InStr(Name, Chr(0)) - 1)) & " = " & S & vbCrLf
ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = Left(S2, InStr(S2, Chr(0)) - 1)
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & S & vbCrLf
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & "(" & j & ") = " & SArr(j) & vbCrLf
Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim L As Long
RegEnumValueAsAny hkey, idx, Name, lenName, ByVal 0, typeData, L, lenData
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = " & L & vbCrLf
Case REG_BINARY
ReDim barr(0 To lenData - 1) As Byte
RegEnumValueAsAny hkey, idx, Name, lenName, ByVal 0, typeData, barr(0), lenData
Text1.SelText = Left(Name, InStr(Name, Chr(0)) - 1) & " = "
For j = 0 To UBound(barr)
Text1.SelText = Hex(barr(j)) & ""
Next
Text1.SelText = vbCrLf
End Select
idx = idx + 1
Wend
RegCloseKey hkey
End SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub Form_Load()
Caption = "枚举指定子项中的所有的值"
Command1.Caption = "显示"
Command2.Caption = "退出"
Label1.Caption = "选择控制项"
Label2.Caption = "输入子项"
Text1 = ""
Text2 = ""
List1.AddItem "HKEY_CLASSES_ROOT"
List1.AddItem "HKEY_CURRENT_USER"
List1.AddItem "HKEY_LOCAL_MACHINE"
List1.AddItem "HKEY_USERS"
List1.AddItem "HKEY_CURRENT_USER"
End SubPrivate Sub List1_Click()
lKey = List1.Text
End Sub

Answer 3

也有枚举项
HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM\
下有多少子键的方法:
新建立一个工程.添加四个CommandButton控件(Command1,Command2,Command3,Command4)
三个Label控件(label1,label2,label3)
一个TextBox(text1)一个ListBox(List1),一个ComBobox(Combo1)
然后在窗体中写入如下代码:
Option Explicit
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_MULTI_SZ = 7Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End TypePrivate Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
Dim lKey As String
Dim cKey As Long
Dim sKey As String
Dim hKey As Long
Dim ret As Long
Dim flags As Boolean
Private Sub Combo1_Click()
lKey = Combo1.Text
End SubPrivate Sub Command1_Click()
Select Case lKey
Case "HKEY_CLASSES_ROOT"
cKey = &H80000000
Case "HKEY_CURRENT_USER"
cKey = &H80000001
Case "HKEY_LOCAL_MACHINE"
cKey = &H80000002
Case "HKEY_USERS"
cKey = &H80000003
Case "HKEY_CURRENT_CONFIG"
cKey = &H80000005
Case ""
MsgBox "请选择控制项"
Exit Sub
End Select
sKey = Text1.Text
ret = RegOpenKeyEx(cKey, sKey, 0, KEY_ALL_ACCESS, hKey)
If ret <> 0 Then Exit Sub
Label3.Caption = "注册表项已打开"
flags = True
End SubPrivate Sub Command2_Click()
Dim Name As String
Dim Idx As Long
Dim nSubKey As Long
Dim maxSubKeyLen As Long
Dim maxClassLen As Long
Dim nValue As Long
Dim maxValueNameLen As Long
Dim maxValueLen As Long
Dim sd As Long
Dim WriteTime As FILETIME
Caption = "枚举指定项中所有子项"
If flags = False Then
MsgBox "请先打开注册表项"
Exit Sub
End If
List1.Clear
ret = RegQueryInfoKey(hKey, vbNullString, 0, ByVal 0, nSubKey, maxSubKeyLen, maxClassLen, nValue, maxValueNameLen, maxValueLen, sd, WriteTime)
Name = String(maxSubKeyLen + 1, Chr(0))
For Idx = 0 To nSubKey - 1
ret = RegEnumKey(hKey, Idx, Name, Len(Name))
If ret = 0 Then
List1.AddItem Left(Name, InStr(Name, Chr(0)) - 1)
End If
Next
Label3.Caption = lKey & "\" & sKey & "中的子项数为:" & Idx
End SubPrivate Sub Command3_Click()
Dim nSubKey As Long
Dim maxSubKeyLen As Long
Dim maxClassLen As Long
Dim nValue As Long
Dim maxValueNameLen As Long
Dim maxValueLen As Long
Dim sd As Long
Dim WriteTime As FILETIME
Caption = "显示指定项的信息"
If flags = False Then
MsgBox "请先打开注册表项"
Exit Sub
End If
ret = RegQueryInfoKey(hKey, vbNullString, 0, ByVal 0, nSubKey, maxSubKeyLen, maxClassLen, nValue, maxValueNameLen, maxValueLen, sd, WriteTime)
List1.Clear
List1.AddItem "子项的数目 =" & nSubKey
List1.AddItem "最长子项的长度 =" & maxSubKeyLen
List1.AddItem "值的数目 =" & nValue
List1.AddItem "最长的值名称长度 =" & maxValueNameLen
List1.AddItem "最长的值的数据的长度 =" & maxValueLen
RegCloseKey hKey
Label3.Caption = ""
End SubPrivate Sub Command4_Click()
Unload Me
End SubPrivate Sub Form_Load()
Command1.Caption = "打开注册表项"
Command2.Caption = "显示子项"
Command3.Caption = "显示信息"
Command4.Caption = "退出"
Label1.Caption = "选择控制项"
Label2.Caption = "输入子项"
Text1 = ""
Combo1.Text = ""
Label3.Caption = ""
Label3.AutoSize = True
Combo1.AddItem "HKEY_CLASSES_ROOT"
Combo1.AddItem "HKEY_CURRENT_USER"
Combo1.AddItem "HKEY_LOCAL_MACHINE"
Combo1.AddItem "HKEY_USERS"
Combo1.AddItem "HKEY_CURRENT_CONFIG"
Combo1.ListIndex = 0
flags = False
End Sub

Answer 4

明白了。thanks
可以交个朋友吗。
22112287