用api函数实现的,一个按钮,一个listbox:
Option Explicit
Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) 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 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 Any) As Long
Private Declare Function RegEnumValue 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 Byte, lpcbData As Long) As Long
Private Sub Command1_Click()
Dim hKey As Long, Cnt As Long, sSave As String
RegOpenKey HKEY_LOCAL_MACHINE, "Hardware\DeviceMap\SerialComm", hKey
Cnt = 0
List1.Clear
Do
'Create a bufferHKEY_LOCAL_MACHINE\Hardware\DeviceMap\SerialComm
sSave = String(255, 0)
'enumerate the values
If RegEnumValue(hKey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
'pritn the results to the form
List1.AddItem StripTerminator(sSave)
Cnt = Cnt + 1
Loop
'Close the registry
RegCloseKey hKey
End Sub
'This function is used to stripoff all the unnecessary chr$(0)'s
Private Function StripTerminator(sInput As String) As String
Dim ZeroPos As Integer
'Search the first chr$(0)
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If
End Function
用错误陷阱:
Private Sub Command2_Click()
On Error GoTo myerr
Dim i As Long
For i = 1 To 1000
Open "com" + CStr(i) For Binary As #1
Close #1
Next
Exit Sub
myerr:
MsgBox "共有" + CStr(i - 1) + "个串口"
End Sub