新手上路,如何能实现保存发送及接收到的数据?请指教
communication.zip
(11.61 KB)
Dim txt As String
'保存接收到的内容为文本文件
Private Sub cmdSave_Click()
Dim FileNumber
Dim strOuttmpFile As String '定义输出文件的名称
Dim strPrintTxt As String '定义输出文件的内容
strOuttemFile = App.Path & "mytxt.txt"
strPrintTxt = TextReceive1.Text & "|" & TextReceive2.Text
On Error GoTo errorhandler
FileNumber = FreeFile '打开文件并追写新数据到文件尾
Open strOuttmpFile For Append As #FileNumber
Print #FileNumber, strPrintTxt
Close #FileNumber
errorhandler: MsgBox "错误", "error"
End Sub
'初始化串口
Private Sub Form_Load()
If Not Init_Com("COM1:", "9600,n,8,1") Then '端口选择
MsgBox "端口" & "无效!"
Exit Sub
End If
End Sub
'发送字符
Private Sub BTNSend_Click()
'If WriteCOM32(txt(2)) & vbCr <> Len(txt(2)) Then
If WriteCOM32(TextReceive) & vbCr <> Len(Textsend) Then
MsgBox "写入错误"
Exit Sub
End If
End Sub
'向串口写数据
Function WriteCOM32(COMString As String) As Integer
On Error GoTo handelwritelpt
Dim RetBytes As Long, LenVal As Long
Dim retval As Long
If Len(COMString) > 255 Then
WriteCOM32 Left$(COMString, 255)
WriteCOM32 Right$(COMString, Len(COMString) - 255)
Exit Function
End If
For LenVal = 0 To Len(COMString) - 1
bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
Next LenVal
retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, 0)
WriteCOM32 = RetBytes
handelwritelpt:
Exit Function
End Function
'读取数据
Private Sub TMRComm_Timer()
Dim Ans As String, i As Integer, RtnStr As String
Ans = ReadCommPure()
If Ans = "" Then
Exit Sub
End If
RtnStr = RtnStr & CleanStr(Ans)
txtRec.Text = RtnStr
FlushComm
End Sub
'从串口读取数据
Function ReadCommPure() As String
On Error GoTo handelpurecom
Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
Dim CheckTotal As Integer, CheckDigitLC As Integer
retval = ReadFile(ComNum, bRead(0), 255, RetBytes, 0)
ReadStr = ""
If (RetBytes > 0) Then
For i = 0 To RetBytes - 1
ReadStr = ReadStr & Chr(bRead(i))
Next i
Else
FlushComm
End If
ReadCommPure = ReadStr
handelpurecom:
Exit Function
End Function
Function CleanStr(TextLine As String) As String
Dim i As Integer, RtnStr As String
RtnStr = ""
For i = 1 To Len(TextLine)
Select Case Asc(Mid$(TextLine, i, 1))
Case &H5D
RtnStr = RtnStr & "<ACK>"
Case &H5B
RtnStr = RtnStr & "<NAK>"
Case Is >= &H30
RtnStr = RtnStr & Mid$(TextLine, i, 1)
Case 13
RtnStr = RtnStr & "<CR>"
Case 10
RtnStr = RtnStr & "<LF>"
Case Else
RtnStr = RtnStr & "@"
End Select
Next i
CleanStr = RtnStr
End Function
'清空文件缓冲区
Function FlushComm()
FlushFileBuffers (ComNum)
End Function
'初始化端口
Function Init_Com(ComNumber As String, Comsettings As String) As Boolean
On Error GoTo handelinitcom
Dim ComSetup As DCB, Answer, Stat As COMSTAT, RetBytes As Long
Dim retval As Long
Dim CtimeOut As COMMTIMEOUTS, BarDCB As DCB
'打开通讯口读/写(&HC0000000).
'必须指定存在的文件(3).
ComNum = CreateFile(ComNumber, &HC0000000, 0, 0&, &H3, 0, 0)
If ComNum = -1 Then
MsgBox "端口" & ComNumber & "无效。请设置正确", 48
Init_Com = False
Exit Function
End If
'超时
CtimeOut.ReadIntervalTimeout = 20
CtimeOut.ReadTotalTimeoutConstant = 1
CtimeOut.ReadTotalTimeoutMultiplier = 1
CtimeOut.WriteTotalTimeoutConstant = 10
CtimeOut.WriteTotalTimeoutMultiplier = 1
retval = SetCommTimeouts(ComNum, CtimeOut)
If retval = -1 Then
retval = GetLastError()
MsgBox "端口超时设定无效" & ComNumber & "错误: " & retval
retval = CloseHandle(ComNum)
Init_Com = False
Exit Function
End If
retval = BuildCommDCB(Comsettings, BarDCB)
If retval = -1 Then
retval = GetLastError()
MsgBox "无效设备DCB块?" & Comsettings & "错误: " & retval
retval = CloseHandle(ComNum)
Init_Com = False
Exit Function
End If
retval = SetCommState(ComNum, BarDCB)
If retval = -1 Then
retval = GetLastError()
MsgBox "无效设备DCB块?" & Comsettings & "错误: " & retval
retval = CloseHandle(ComNum)
Init_Com = False
Exit Function
End If
Init_Com = True
handelinitcom:
Exit Function
End Function
'关闭程序
Private Sub BTNCloseCom_Click()
Unload Me
End Sub
'关闭端口
Private Sub Form_Unload(Cancel As Integer)
CloseHandle (ComNum)
End Sub