经典的串口调试工具源代码(二)

1、经典的串口调试工具源代码（二）Private Sub cmdswitch_Click()On Error GoTo Err    If MSComm.PortOpen = True Then        ComSwitch = True    Else        ComSwitch = False    End If    

2、0;   If ComSwitch = False Then     StatusBar1.Panels(1).Text = "Connected"        mnuconnect.Caption = "Dis&connect"        OpenCom       

3、60;                ' 打开串口        ComSwitch = True    Else        CloseCom          

4、60;            ' 关闭串口        ComSwitch = False        StatusBar1.Panels(1).Text = "Disconnected"        mnuconnect.Caption = &

5、quot;&Connect"        StatusBar1.Panels(2).Text = "COM" & MSComm.CommPort    StatusBar1.Panels(3).Text = MSComm.Settings         If (OutputAscii) Then      &

6、#160;      StatusBar1.Panels(4) = "ASCII"         Else             StatusBar1.Panels(4) = "HEX"        End If  

7、;  End If  Err: End SubPrivate Sub Form_Load()On Error GoTo Err    lblWEB.FontUnderline = True                             &#

8、160;                       ' WEB上加下划线    lblWEB.ForeColor = vbBlue                 

9、60;                                     ' 蓝色显示WEB        txtsend.Text = ""&#

10、160;                               ' 载入发送信息    If MSComm.PortOpen = True Then MSComm.PortOpen = False     

11、                     ' 先判断串口是否打开，如果打开则先关闭                          

12、;                                                  

13、;        ' 初始化串口    Call Comm_initial(Val(Mid(cbocom.Text, 4, 1), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text)               ' 数据位载入    c

14、bodatabit.AddItem "8"    cbodatabit.AddItem "7"    cbodatabit.AddItem "6"        ' 停止位载入    cbostopbit.AddItem "1"    cbostopbit.AddItem "1.5"  &#

15、160; cbostopbit.AddItem "2"Err:End SubPrivate Sub hexReceive() On Error GoTo Err    Dim ReceiveArr() As Byte                           

16、                             ' 接收数据数组    Dim receiveData As String            

17、60;                                          ' 数据暂存    Dim Counter As Intege

18、r                                                  

19、;        ' 接收数据个数计数器    Dim i As Integer                                  &#

20、160;                             ' 循环变量        If (MSComm.InBufferCount > 0) Then       

21、 Counter = MSComm.InBufferCount                                             

22、; ' 读取接收数据个数        receiveData = ""                                    

23、;                        ' 清缓冲                ReceiveArr = MSComm.Input      

24、0;                                            ' 数据放入数组    

25、60;   For i = 0 To (Counter - 1) Step 1                                          

26、; ' 数据格式处理            If (ReceiveArr(i) < 16) Then                receiveData = receiveData & "0" + Hex(ReceiveArr(i) & Space(1)   

27、;  ' 小于16，前面加0            Else                receiveData = receiveData & Hex(ReceiveArr(i) & Space(1)        

28、60;  ' 加空格显示            End If        Next i                TxtReceive.Text = TxtReceive.Text + receiveData    

29、                         ' 显示接收的十六进制数据        TxtReceive.SelStart = Len(TxtReceive.Text)         

30、;                         ' 显示光标位置    End If        ReceiveCount = ReceiveCount + Counter       

31、                                    ' 接收计数    txtRXcount.Text = "RX:" & ReceiveCount &#

32、160;                                        ' 接收字节数显示        If chkauto

33、clear.Value = 1 Then                                              

34、0;   ' 自动清空判断        If ReceiveCount >= 65535 Then            TxtReceive.Text = ""        End If    End IfErr:End SubPrivate Sub hexS

35、end()On Error Resume Next    Dim outputLen As Integer                                      

36、0;                 ' 发送数据长度    Dim outData As String                         

37、;                                  ' 发送数据暂存    Dim SendArr() As Byte        

38、                                                  

39、 ' 发送数组    Dim TemporarySave As String                                        

40、60;            ' 数据暂存    Dim dataCount As Integer                             

41、60;                          ' 数据个数计数    Dim i As Integer                

42、60;                                               ' 局部变量 

43、0;      outData = UCase(Replace(txtsend.Text, Space(1), Space(0)                        ' 先去掉空格，再转换为大写字母    outData = UCase(outData)  &#

44、160;                                                 &#

45、160;   ' 转换成大写    outputLen = Len(outData)                                      &

46、#160;                 ' 数据长度        For i = 0 To outputLen        TemporarySave = Mid(outData, i + 1, 1)        

47、;                              ' 取一位数据        If (Asc(TemporarySave) >= 48 And Asc(TemporarySave) <= 57) Or (A

48、sc(TemporarySave) >= 65 And Asc(TemporarySave) <= 70) Then            dataCount = dataCount + 1        Else            Exit For   

49、0;        Exit Sub        End If    Next        If dataCount Mod 2 <> 0 Then                 &

50、#160;                                  ' 判断十六进制数据是否为双数        dataCount = dataCount - 1 

51、60;                                                 ' 不是

52、双数，则减1    End If        outData = Left(outData, dataCount)                                 

53、;             ' 取出有效的十六进制数据        ReDim SendArr(dataCount / 2 - 1)                       &

54、#160;                        ' 重新定义数组长度    For i = 0 To dataCount / 2 - 1        SendArr(i) = Val("&H" + Mid(outData,

55、 i * 2 + 1, 2)                         ' 取出数据转换成十六进制并放入数组中    Next        SendCount = SendCount + (dataCount / 2)   

56、                                      ' 计算总发送数    txtTXcount.Text = "TX:" & SendCo

57、unt             MSComm.Output = SendArr                                  &#

58、160;                      ' 发送数据End SubPrivate Sub OpenCom() '打开串口On Error GoTo Err    If MSComm.PortOpen = True Then MSComm.PortOpen = False     &

59、#160;                    ' 先判断串口是否打开，如果打开则先关闭            Call Comm_reSet(Val(Mid(cbocom.Text, 4, 1), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbod

60、atabit.Text, cbostopbit.Text)             ' 串口设置        If MSComm.PortOpen = True Then        txtstatus.Text = "STATUS：" & cbocom.Text & " OPEND，&qu

61、ot; & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1) & "," & cbodatabit.Text & "," & cbostopbit.Text        cmdswitch.Caption = "关闭串口"        mnuconnect.Capt

62、ion = "disconnect"        'ImgSwitch.Picture = LoadPicture("f:我的VB串口调试软件图片kai.jpg")      ' 显示串口已经打开的图标        ImgSwitchon.Visible = True       

63、; ImgSwitchoff.Visible = False    Else        txtstatus.Text = "STATUS：COM Port Cloced"                         

64、60;        ' 串口状态显示        cmdswitch.Caption = "打开串口"        mnuconnect.Caption = "connect"        'ImgSwitch.Picture = LoadPicture(

65、"f:我的VB串口调试软件图片guan.jpg")     ' 显示串口已经关闭的图标        ImgSwitchoff.Visible = True        ImgSwitchon.Visible = False    End IfErr:    End SubPrivate Sub textReceive()On

66、Error GoTo Err    InputSignal = MSComm.Input    ReceiveCount = ReceiveCount + LenB(StrConv(InputSignal, vbFromUnicode)        ' 计算总接收数据    If DisplaySwitch = False Then        

67、                                          ' 显示接收文本       

68、; TxtReceive.Text = TxtReceive.Text & InputSignal                            ' 单片机内存的值用TextReceive显示出        TxtReceive.Se

69、lStart = Len(TxtReceive.Text)                                 ' 显示光标位置    End If    txtRXcount.Text = &quo

70、t;RX:" & ReceiveCount                                         ' 接收字节数显示  

71、0;     If chkautoclear.Value = 1 Then                                         &#

72、160;       ' 自动清空判断        If ReceiveCount >= 65535 Then            TxtReceive.Text = ""        End If    End IfE

73、rr:            End SubPrivate Sub textSend()On Error GoTo Err    If ModeSend = True Then        OutputSignal = FileData            

74、0;                                        ' 发送文件    Else     

75、   OutputSignal = txtsend.Text                                           &#

76、160;     ' 发送文本    End If                SendCount = SendCount + LenB(StrConv(OutputSignal, vbFromUnicode)              '

77、计算总发送数    txtTXcount.Text = "TX:" & SendCount                                     

78、0;       ' 发送字节数显示Err:            End SubPrivate Sub Image1_Click()End Sub Private Sub mnuautosend_Click()On Error GoTo Err    'If TmrAutoSend.Enabled = True Then    &

79、#160;                                              ' 如果有效则，自动发送 &#

80、160;      If MSComm.PortOpen = True Then                                       &

81、#160;      ' 串口状态判断            ChkAutoSend.Value = 1            TmrAutoSend.Interval = Val(TxtAutoSendTime)         

82、                    ' 设置自动发送时间            mnuautosend.Caption = "取消自动发送"          

83、0; TmrAutoSend.Enabled = True                                             

84、' 打开自动发送定时器        Else                mnuautosend.Caption = "自动发送"            ChkAutoSend.Value = 0   

85、60;                                               ' 串口没有打开去掉自动发送&#

86、160;           MsgBox "串口没有打开，请打开串口", 48, "串口调试助手"                   ' 如果串口没有被打开，提示打开串口        End If

87、    'ElseIf TmrAutoSend.Enabled = False Then                                       

88、60;       ' 如果无效，不发送    '        mnuautosend.Caption = "autosend"     '      TmrAutoSend.Enabled = False        &

89、#160;                                    ' 关闭自动发送定时器    'End IfErr:End SubPrivate Sub mnucom_Click(Ind

90、ex As Integer)    Dim i As Integer    Dim OldPort As Long        On Error Resume Next    With MSComm        OldPort = .CommPort        If MSComm.PortOpen T

91、hen            .PortOpen = False            .CommPort = Index            .PortOpen = True       

92、0;    If Err.Number <> 0 Then     ' This should not happen.                MsgBox "Com" & Index & " is not available." & _    &#

93、160;                       vbCrLf & Err.Description                Err.Clear      

94、;          .CommPort = OldPort            Else                For i = 1 To 4        &

95、#160;           mnucom(i).Checked = False                Next i                mnucom(Index).Checked

96、 = True            End If        Else            .CommPort = Index            For i = 1 To 4 &#

97、160;              mnucom(i).Checked = False            Next i            mnucom(Index).Checked = True    

98、    End If    End With    UpdateStatusEnd SubPrivate Sub mnuconnect_Click()    On Error Resume Next    If MSComm.PortOpen = True Then        ComSwitch = True    Else 

99、0;      ComSwitch = False    End If    With MSComm        If .PortOpen = True Then            .PortOpen = False       &#

100、160; txtstatus.Text = "STATUS：COM Port Cloced"                                  ' 串口状态显示     

101、60;  cmdswitch.Caption = "打开串口"                'ImgSwitch.Picture = LoadPicture("f:我的VB串口调试软件图片guan.jpg")     ' 显示串口已经关闭的图标        ImgSwitchof

102、f.Visible = True        ImgSwitchon.Visible = False                Else            .PortOpen = True       

103、;     ComSwitch = True                 txtstatus.Text = "STATUS：" & cbocom.Text & " OPEND，" & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1) &

104、; "," & cbodatabit.Text & "," & cbostopbit.Text        cmdswitch.Caption = "关闭串口"                'ImgSwitch.Picture = LoadPicture("f:我的VB串口调试软件图

105、片kai.jpg")      ' 显示串口已经打开的图标        ImgSwitchon.Visible = True        ImgSwitchoff.Visible = False                 

106、        If Err.Number <> 0 Then                MsgBox "Com" & .CommPort & " is not available." & vbCrLf & _       

107、;                                         Err.Description       &

108、#160;        Err.Clear            End If        End If    End With     UpdateStatus   End SubPrivate Sub mnusave_Click()On Error GoTo E

109、rr                                                 

110、0;             ' 错误处理    SaveTextPath = txtsavepath                            &#

111、160;                         ' 路径暂存    Open txtsavepath & "1.txt" For Output As #1           

112、;                         ' 打开文件                        

113、                                                  

114、          ' 不存在的话 会创建文件,如已存在 会覆盖                                    

115、60;                                               ' output 改为appen

116、d 为追加                                                 &

117、#160;                                  ' 改为input 则只读    Print #1, Year(Date) & "年" & Month(Date) &

118、amp; "月" & Day(Date) & _    "日" & Hour(Time) & "时" & Minute(Time) & "分" & Second(Time) & _    "秒" & vbCrLf & TxtReceive.Text + vbCrLf        

119、;                                ' 把接收区的文本保存 文本前加上保存时间 （0000年00月00日00时00分00秒）          

120、0;                                                 

121、0;                       ' vbcrlf 为回车换行    Close #1                    

122、                                                  

123、  ' 关闭文件        txtsavepath = "OK,1.txt Save"                                  &#

124、160;                ' 提示保存成功    cmdsavedisp.Enabled = False            Savetime = Timer           

125、60;                                                 

126、60;  ' 记下开始的时间    While Timer < Savetime + 5                                      &

127、#160;               ' 循环等待 5 - 要延时的时间        DoEvents                       

128、                                             ' 转让控制权，以便让操作系统处理其它的事件。 &#

129、160;  Wend    txtsavepath = SaveTextPath                                        

130、              ' 显示保存路径    cmdsavedisp.Enabled = TrueErr:End SubPrivate Sub MSComm_OnComm()    On Error GoTo Err    Select Case MSComm.CommEvent       &

131、#160;                                            ' 每接收1个数就触发一次   &

132、#160;    Case comEvReceive            If ChkHexReceive.Value = 1 Then                Call hexReceive         &

133、#160;                                           ' 十六进制接收     

134、       Else                Call textReceive                         &#

135、160;                          ' 文本接收        End If               &

136、#160;    Case comEvSend                                           

137、0;                  ' 每发送1个数就触发一次            If ChkHexsend.Value = 1 Then            Else  

138、              Call textSend                                  

139、0;                    ' 文本发送            End If                    Case Else    End SelectErr:  End SubPrivate Sub TmrAutoSend_Timer()On Error GoTo Err    If txtsen