7453
社区成员
- 主页
怎样知道所要设置的串口是否存在?(新手上路)
譬如我设置了MSComm.commport为3(实际不存在),但是只有到了我设置MSComm.open为true的时候,才提示错误,并强行退出了程序.
第一个问题:我怎样知道它不存在,并提前提示
第二个问题:如果提示错误,我怎样不让它退出,并且根据错误代码判断错误类型.
第一个问题:我怎样知道它不存在,并提前提示
第二个问题:如果提示错误,我怎样不让它退出,并且根据错误代码判断错误类型.
...全文
当前发帖距今超过3年，不再开放新的回复
发表回复
智能卡_Snooper 2003-01-23
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public 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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const KEY_QUERY_VALUE = &H1
Public Const HKEY_LOCAL_MACHINE = &H80000002
ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Hardware\DeviceMap\SerialComm", 0, KEY_QUERY_VALUE, dwResult)
strData = String$(255, 0)
cbData = Len(strData)
ret = RegQueryValueEx(dwResult, "COM2", ByVal 0, dwType, ByVal strData, cbData)
Com2Ok = (ret = 0 And Left(strData, cbData - 1) = "COM2")
ret = RegCloseKey(dwResult)
Public 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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const KEY_QUERY_VALUE = &H1
Public Const HKEY_LOCAL_MACHINE = &H80000002
ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Hardware\DeviceMap\SerialComm", 0, KEY_QUERY_VALUE, dwResult)
strData = String$(255, 0)
cbData = Len(strData)
ret = RegQueryValueEx(dwResult, "COM2", ByVal 0, dwType, ByVal strData, cbData)
Com2Ok = (ret = 0 And Left(strData, cbData - 1) = "COM2")
ret = RegCloseKey(dwResult)
along 2003-01-23
难！！！
alion 2003-01-21
不用API行吗?
leehq 2003-01-14
EnumPorts好像只能列举并口...
along 2003-01-14
楼上不对，其既可列举串口又可列举并口；不信用以上代码运行一下看看吗？
along 2003-01-14
'给你一段代码
'它可以找出系统的串口并可指出哪个串口正在使用
'哪个没有使用
'以下在BAS中
Option Explicit
'API调用
Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
'API类型
Private Type PORT_INFO_2
pPortName As String
pMonitorName As String
pDescription As String
fPortType As Long
Reserved As Long
End Type
Private Type API_PORT_INFO_2
pPortName As Long
pMonitorName As Long
pDescription As Long
fPortType As Long
Reserved As Long
End Type
Private Const OFS_MAXPATHNAME = 260
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Dim Fs As OFSTRUCT
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'‘定义一下标为100的数组用于存放IO口
Public Ports(0 To 100) As PORT_INFO_2
'删除字符串中的空字符
Function TrimStr(strName As String) As String
Dim x As Integer
x = InStr(strName, vbNullChar)
If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
End Function
'转换为UNICODE代码即转换为可识别的内容
Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
Dim lngLength As Long
lngLength = lstrlenW(lngPointer) * 2
LPSTRtoSTRING = String(lngLength, 0)
CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function
'servername为要列举串口的机器的名，若为本机则为空字符
'GetAvailablePorts返回机器的串口数目
Public Function GetAvailablePorts(ServerName As String) As Long
Dim ret As Long
Dim PortsStruct(0 To 100) As API_PORT_INFO_2
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim TempBuff As Long
Dim i As Integer
'判断所要内存的数据
ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
'分配调用内存
TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
'枚举串口至分配的内存区
ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
If ret Then
'从内存中拷贝串口数据至数组
CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
Dim I0 As Integer
For i = 0 To pcReturned - 1
'控制只列举串行通信端口
If PortsStruct(i).fPortType = 3 And InStr(1, LPSTRtoSTRING(PortsStruct(i).pDescription), "通讯端口", 1) Then
Ports(I0).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
Ports(I0).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
Ports(I0).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
Ports(I0).fPortType = PortsStruct(i).fPortType
I0 = I0 + 1
End If
Next
End If
GetAvailablePorts = I0
'释放内存
If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
End Function
'判串口是否打开
Public Function PortOpenYesNo(ByVal ComName As String) As Boolean
Dim Hwd As Long
Hwd = OpenFile(ComName, Fs, 0)
If Hwd = -1 Then
PortOpenYesNo = True
Else
PortOpenYesNo = False
CloseHandle Hwd
End If
End Function
以下在FORM中
在FORM中添加一LISTVIEW控件与一命令按钮编辑运行点击命令按钮即可
Private Sub Command1_Click()
Dim NumPorts As Long, Lst As ListItem
Dim i As Integer, x As Long
NumPorts = GetAvailablePorts("")
ListView1.ListItems.Clear
'添加到列表框
For i = 0 To NumPorts - 1
Set Lst = ListView1.ListItems.Add()
Lst.Text = Ports(i).pPortName
x = InStr(Ports(i).pPortName, ":")
If x Then Ports(i).pPortName = Mid$(Ports(i).pPortName, 1, x - 1)
If PortOpenYesNo(Ports(i).pPortName) = False Then
Lst.SubItems(1) = "当前没有使用"
Else
Lst.SubItems(1) = "当前正在使用"
End If
Next
End Sub
'它可以找出系统的串口并可指出哪个串口正在使用
'哪个没有使用
'以下在BAS中
Option Explicit
'API调用
Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
'API类型
Private Type PORT_INFO_2
pPortName As String
pMonitorName As String
pDescription As String
fPortType As Long
Reserved As Long
End Type
Private Type API_PORT_INFO_2
pPortName As Long
pMonitorName As Long
pDescription As Long
fPortType As Long
Reserved As Long
End Type
Private Const OFS_MAXPATHNAME = 260
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Dim Fs As OFSTRUCT
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'‘定义一下标为100的数组用于存放IO口
Public Ports(0 To 100) As PORT_INFO_2
'删除字符串中的空字符
Function TrimStr(strName As String) As String
Dim x As Integer
x = InStr(strName, vbNullChar)
If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
End Function
'转换为UNICODE代码即转换为可识别的内容
Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
Dim lngLength As Long
lngLength = lstrlenW(lngPointer) * 2
LPSTRtoSTRING = String(lngLength, 0)
CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function
'servername为要列举串口的机器的名，若为本机则为空字符
'GetAvailablePorts返回机器的串口数目
Public Function GetAvailablePorts(ServerName As String) As Long
Dim ret As Long
Dim PortsStruct(0 To 100) As API_PORT_INFO_2
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim TempBuff As Long
Dim i As Integer
'判断所要内存的数据
ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
'分配调用内存
TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
'枚举串口至分配的内存区
ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
If ret Then
'从内存中拷贝串口数据至数组
CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
Dim I0 As Integer
For i = 0 To pcReturned - 1
'控制只列举串行通信端口
If PortsStruct(i).fPortType = 3 And InStr(1, LPSTRtoSTRING(PortsStruct(i).pDescription), "通讯端口", 1) Then
Ports(I0).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
Ports(I0).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
Ports(I0).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
Ports(I0).fPortType = PortsStruct(i).fPortType
I0 = I0 + 1
End If
Next
End If
GetAvailablePorts = I0
'释放内存
If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
End Function
'判串口是否打开
Public Function PortOpenYesNo(ByVal ComName As String) As Boolean
Dim Hwd As Long
Hwd = OpenFile(ComName, Fs, 0)
If Hwd = -1 Then
PortOpenYesNo = True
Else
PortOpenYesNo = False
CloseHandle Hwd
End If
End Function
以下在FORM中
在FORM中添加一LISTVIEW控件与一命令按钮编辑运行点击命令按钮即可
Private Sub Command1_Click()
Dim NumPorts As Long, Lst As ListItem
Dim i As Integer, x As Long
NumPorts = GetAvailablePorts("")
ListView1.ListItems.Clear
'添加到列表框
For i = 0 To NumPorts - 1
Set Lst = ListView1.ListItems.Add()
Lst.Text = Ports(i).pPortName
x = InStr(Ports(i).pPortName, ":")
If x Then Ports(i).pPortName = Mid$(Ports(i).pPortName, 1, x - 1)
If PortOpenYesNo(Ports(i).pPortName) = False Then
Lst.SubItems(1) = "当前没有使用"
Else
Lst.SubItems(1) = "当前正在使用"
End If
Next
End Sub
