📄 frmcom.frm
字号:
Begin VB.Label Label15
Caption = "串 口 名："
Height = 255
Left = -69600
TabIndex = 31
Top = 960
Width = 1215
End
Begin VB.Label Label14
Caption = "波 特 率："
Height = 255
Left = -69600
TabIndex = 30
Top = 1560
Width = 1095
End
Begin VB.Label Label13
Caption = "数 据 位："
Height = 255
Left = -69600
TabIndex = 29
Top = 2160
Width = 1095
End
Begin VB.Label Label12
Caption = "停 止 位："
Height = 255
Left = -69600
TabIndex = 28
Top = 2760
Width = 1095
End
Begin VB.Label Label11
Caption = "奇偶校验位："
Height = 255
Left = -69600
TabIndex = 27
Top = 3480
Width = 1095
End
Begin VB.Label Label10
Caption = "奇偶校验位："
Height = 255
Left = 5520
TabIndex = 13
Top = 3480
Width = 1095
End
Begin VB.Label Label9
Caption = "停 止 位："
Height = 255
Left = 5520
TabIndex = 12
Top = 2760
Width = 1095
End
Begin VB.Label Label8
Caption = "数 据 位："
Height = 255
Left = 5520
TabIndex = 11
Top = 2160
Width = 1095
End
Begin VB.Label Label7
Caption = "波 特 率："
Height = 255
Left = 5520
TabIndex = 10
Top = 1560
Width = 1095
End
Begin VB.Label Label6
Caption = "串 口 名："
Height = 255
Left = 5520
TabIndex = 9
Top = 960
Width = 1215
End
Begin VB.Label Label5
Caption = "奇偶校验位："
Height = 255
Left = -69480
TabIndex = 8
Top = 3480
Width = 1095
End
Begin VB.Label Label4
Caption = "停 止 位："
Height = 255
Left = -69480
TabIndex = 7
Top = 2760
Width = 1095
End
Begin VB.Label Label3
Caption = "数 据 位："
Height = 255
Left = -69480
TabIndex = 6
Top = 2160
Width = 1095
End
Begin VB.Label Label2
Caption = "波 特 率："
Height = 255
Left = -69480
TabIndex = 4
Top = 1560
Width = 1095
End
Begin VB.Label Label1
Caption = "串 口 名："
Height = 255
Left = -69480
TabIndex = 2
Top = 960
Width = 1215
End
End
End
Attribute VB_Name = "frmCom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim nSendHand As Long '打开的发送端端口的句柄
Dim nRecvHand As Long '打开的接收端端口的句柄
Private Sub cmdClose_Click()
'关闭串口
Comm.PortOpen = False
staCtl.Panels(1).Text = txtName.Text & " 端口被关闭！"
End Sub
Private Sub cmdCLoseRecv_Click()
nRecvHand = CloseHandle(nRecvHand)
staRApi.Panels(1).Text = "接收端口已经关闭！"
End Sub
Private Sub cmdCloseSend_Click()
nSendHand = CloseHandle(nSendHand)
staSApi.Panels(1).Text = "发送端口已经关闭！"
End Sub
Private Sub cmdCtlRecv_Click()
Dim inBuff As String
Dim nLen As Long
'接收数据
inBuff = Comm.Input
nLen = Len(Trim$(inBuff))
txtCtl.Text = "已接收" & nLen & "个字节的数据！" & vbCrLf
txtCtl.Text = txtCtl.Text & Trim$(inBuff)
End Sub
Private Sub cmdCtlSend_Click()
Dim sSend As String
Dim nLen As Long
On Error GoTo err
sSend = Trim$(txtCtlInput.Text)
nLen = Len(sSend)
'发送数据
Comm.Output = sSend
txtCtl.Text = txtCtl.Text & "已发送" & nLen & "个字节的数据！" & vbCrLf
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub cmdOpen_Click()
Dim sSetting As String
Dim portName As String
On Error GoTo err
portName = Trim$(txtName.Text)
'取得COM的端口号
Comm.CommPort = CLng(Mid$(portName, 4))
'下面4条语句用来设置MSComm控件的Settings属性，注意顺序不能改变
sSetting = sSetting & CLng(Trim$(txtBaud.Text)) & ","
'这里只要一个字符，不能为整个字符串
sSetting = sSetting & Left$(Trim$(cboOdd.Text), 1) & ","
sSetting = sSetting & CLng(Trim$(cboData.Text)) & ","
sSetting = sSetting & CLng(Trim$(cboEnd.Text))
Comm.Settings = sSetting
'当接收缓存中有数据的时候就开始接收数据
Comm.RThreshold = 1
'打开串口
Comm.PortOpen = True
staCtl.Panels(1).Text = txtName.Text & " 端口被打开"
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub cmdOpenSend_Click()
Dim nHand As Long '定义打开的串口设备的句柄
Dim dcbConfig As DCB
Dim blnErr As Long
Dim strDCB As String
nHand = CreateFile(Trim$(txtSender.Text), GENERIC_WRITE Or GENERIC_READ, 0&, _
ByVal 0&, OPEN_EXISTING, 0&, 0&)
If nHand = -1 Then
MsgBox "串口打开失败！"
'关闭当前被占用的串口
nHand = CloseHandle(nHand)
Exit Sub
Else
'初始化串口设备的相关参数，输入缓存和输出缓存初始大小为1024
SetupComm nHand, 1024, 1024
'用当前设备的通信属性信息填充缓存区
GetCommState nHand, dcbConfig
dcbConfig.BaudRate = CLng(Trim$(txtSBaud.Text))
dcbConfig.ByteSize = CLng(Trim$(cboSData.Text))
dcbConfig.StopBits = cboSEnd.ListIndex
'奇偶校验位，用对应的索引号即可。这也正好是对应常量的值
dcbConfig.Parity = cboSOdd.ListIndex
'用上面的通信设备的通信信息对通信设备进行设置
blnErr = SetCommState(nHand, dcbConfig)
If blnErr <= 0 Then
MsgBox "串行端口配置错误！"
Exit Sub
End If
nSendHand = nHand
staSApi.Panels(1).Text = "发送端口已经打开！"
End If
End Sub
Private Sub cmdRecv_Click()
Dim sRecv As String
Dim recComState As COMSTAT
Dim ErrorFlag As Long
Dim lResult As Long
Dim NumToRead As Long
Dim NumhaveRead As Long
'通过下面的操作，得到了串口的当前状态
If ClearCommError(nRecvHand, ErrorFlag, recComState) <= 0 Then
PurgeComm nRecvHand, PURGE_RXABORT Or PURGE_RXCLEAR
End If
'为接收区缓存开辟空间
sRecv = Space$(1024)
If recComState.cbInQue > 0 Then
'取得接收缓存区内没有被读取的字节数
NumToRead = recComState.cbInQue
'参数sRecv的传递需要加上关键字ByVal
'对于ByRef的参数传递，如果实参为字符串变量的时候，需要加上ByVal，因为
'字符串变量本身已经指针，如果不用ByVal的话，将传递指针的指针，就出现错误了。
lResult = ReadFile(nRecvHand, ByVal sRecv, NumToRead, _
NumhaveRead, ByVal 0&)
End If
'注意：被注释掉的下面的语句是读取数据的另一种方法，即利用Byte数组的方法。
'紧随上面的读取串口操作放在一起说明是为了进行比较。
'一般而言，利用Byte数组具有更大的通用性。下面的代码经过测试，能够正确运行。
'Dim binRecv() As Byte
'为接收缓存区开辟空间
'ReDim binRecv(0 To 1023)
'lResult = ReadFile(nRecvHand, binRecv(0), NumToRead, _
NumhaveRead, ByVal 0&)
'sRecv = StrConv(binRecv, vbUnicode)
'sRecv = Left$(sRecv, InStr(sRecv, Chr(0)) - 1)
txtRecv.Text = "接收到" & NumhaveRead & "个字节的数据。" & vbCrLf
txtRecv.Text = txtRecv.Text & Trim$(sRecv)
PurgeComm nRecvHand, PURGE_RXABORT Or PURGE_RXCLEAR
End Sub
Private Sub cmdSend_Click()
Dim sSend As String
Dim lenBuf As Long '存放将要写入串口的数据长度
Dim NumberWritten As Long '用来记录写入的字节长度
On Error GoTo err:
NumberWritten = 0
sSend = Trim$(txtInput.Text)
lenBuf = Len(sSend)
'清空缓冲区
PurgeComm nSendHand, PURGE_RXABORT Or PURGE_RXCLEAR
'注意，写入数据也可以使用Byte数组。另外，参数sSend的传递需要加上关键字ByVal
'对于ByRef的参数传递，如果实参为字符串变量的时候，需要加上ByVal，因为
'字符串变量本身已经指针，如果不用ByVal的话，将传递指针的指针，就出现错误了。
If WriteFile(nSendHand, ByVal sSend, lenBuf, NumberWritten, ByVal 0&) <= 0 Then
MsgBox "向串口写数据发生错误！"
End If
txtSend.Text = "已经发送" & lenBuf & "个字节的数据。" & vbCrLf
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub cmdOpenRecv_Click()
Dim nHand As Long '定义打开的串口设备的句柄
Dim dcbConfig As DCB
Dim blnErr As Long
nHand = CreateFile(Trim$(txtAccept.Text), GENERIC_WRITE Or GENERIC_READ, _
0&, ByVal 0&, OPEN_EXISTING, 0&, 0&)
If nHand = -1 Then
MsgBox "串口打开失败！"
'关闭当前被占用的串口
nHand = CloseHandle(nHand)
Exit Sub
Else
SetupComm nHand, 1024, 1024
GetCommState nHand, dcbConfig
dcbConfig.BaudRate = CLng(Trim$(txtABaud.Text))
dcbConfig.ByteSize = CLng(Trim$(cboAData.Text))
dcbConfig.StopBits = cboAEnd.ListIndex 'CLng(Trim$(cboAEnd.Text))
dcbConfig.Parity = cboAOdd.ListIndex
blnErr = SetCommState(nHand, dcbConfig)
If blnErr <= 0 Then
MsgBox "串行端口配置错误！"
Exit Sub
End If
nRecvHand = nHand
staRApi.Panels(1).Text = "接收端口已经打开！"
End If
End Sub
Private Sub Comm_OnComm()
Dim sGet As String
'接收缓冲区的字节数
Dim nLen As Long
Select Case Comm.CommEvent
'当有数据到达缓冲区，即开始接收数据
Case comEvReceive
'延迟3秒，然后开始接收数据，这是为了确保数据能完全的接收
Sleep 3000
nLen = Comm.InBufferCount
sGet = Comm.Input
txtCtl.Text = "已接收" & nLen & "个字节的数据！" & vbCrLf
txtCtl.Text = txtCtl.Text & Trim$(sGet)
End Select
End Sub
Private Sub Form_Load()
txtSBaud.Text = 9600
txtABaud.Text = 9600
txtBaud.Text = 9600
txtSender.Text = "COM1"
txtAccept.Text = "COM2"
cboSData.AddItem 5
cboSData.AddItem 6
cboSData.AddItem 7
cboSData.AddItem 8
cboSData.ListIndex = 3
cboAData.AddItem 5
cboAData.AddItem 6
cboAData.AddItem 7
cboAData.AddItem 8
cboAData.ListIndex = 3
cboData.AddItem 5
cboData.AddItem 6
cboData.AddItem 7
cboData.AddItem 8
cboData.ListIndex = 3
cboSEnd.AddItem 1
cboSEnd.AddItem 1.5
cboSEnd.AddItem 2
cboSEnd.ListIndex = 0
cboAEnd.AddItem 1
cboAEnd.AddItem 1.5
cboAEnd.AddItem 2
cboAEnd.ListIndex = 0
cboEnd.AddItem 1
cboEnd.AddItem 1.5
cboEnd.AddItem 2
cboEnd.ListIndex = 0
cboSOdd.AddItem "None"
cboSOdd.AddItem "Odd"
cboSOdd.AddItem "Even"
cboSOdd.AddItem "Mark"
cboSOdd.AddItem "Space"
cboSOdd.ListIndex = 0
cboAOdd.AddItem "None"
cboAOdd.AddItem "Odd"
cboAOdd.AddItem "Even"
cboAOdd.AddItem "Mark"
cboAOdd.AddItem "Space"
cboAOdd.ListIndex = 0
cboOdd.AddItem "None"
cboOdd.AddItem "Odd"
cboOdd.AddItem "Even"
cboOdd.AddItem "Mark"
cboOdd.AddItem "Space"
cboOdd.ListIndex = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -