 |
你可以尝试逐一打开COM口，如果COM口不存在，会导致错误，错误号为8002。如果被其他软件占用，也可能产生错误，错误号是8005。下面是一个例子：
1、在窗体上放置一个按钮、一个ListBox和一个Microsoft Comm Control控件。
2、输入如下代码：
Private Sub Command1_Click()
Dim i
For i = 1 To 16
MSComm1.CommPort = i
On Error GoTo ErrHandler
MSComm1.PortOpen = True
List1.AddItem "COM" + Format(i) + ":存在"
MSComm1.PortOpen = False
Continue:
Next
Exit Sub
ErrHandler:
If Err.Number = 8005 Then
Resume Next
ElseIf Err.Number = 8002 Then
List1.AddItem "COM" + Format(i) + ":不存在"
Resume Continue
Else
MsgBox Format(Err.Number) + Err.Description
End If
End Sub
 tonton的意见：
我综合了一下，写出下面的代码：
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Function isWinNt() As Boolean
Dim OSInfo As OSVERSIONINFO, Ret As Long
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
Ret = GetVersionEx(OSInfo)
isWinNt = Ret And OSInfo.dwPlatformId = 2
End Function
Function ExistsCom(ByVal Index As Integer) As Boolean
Dim m_hComm As Long, SA As SECURITY_ATTRIBUTES
Dim buf As String
If isWinNt Then
buf = Space(255)
QueryDosDevice "COM" & Index, buf, 255
m_hComm = InStr(1, buf, vbNullChar)
Else
m_hComm = CreateFile("COM" & Index, GENERIC_READ Or GENERIC_WRITE, 0, SA, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0)
End If
ExistsCom = m_hComm
End Function
Private Sub Form_Load()
Dim i As Long
For i = 1 To 16
If ExistsCom(i) Then
Debug.Print "COM" & i
Else
Exit For
End If
Next i
End Sub
 相关问题：
QA002652 "怎样知道计算机有多少个串口"
 相关书籍：
《串行端口大全》
此问题由李海回答。
附加关键字：编程, 源程序, programming, source code, Visual Basic, VB, 网络与通信, network, communicate, com, com1, com2。
|
如何写代码判断机器共有多少个串口
