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