經(jīng)典的串口調(diào)試工具源代碼(二)

1、經(jīng)典的串口調(diào)試工具源代碼（二）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;            ' 關(guān)閉串口        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;                                     ' 藍(lán)色顯示W(wǎng)EB        txtsend.Text = ""&#

10、160;                               ' 載入發(fā)送信息    If MSComm.PortOpen = True Then MSComm.PortOpen = False     

11、                     ' 先判斷串口是否打開，如果打開則先關(guān)閉                          

12、;                                                  

13、;        ' 初始化串口    Call Comm_initial(Val(Mid(cbocom.Text, 4, 1), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text)               ' 數(shù)據(jù)位載入    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、                             ' 接收數(shù)據(jù)數(shù)組    Dim receiveData As String            

17、60;                                          ' 數(shù)據(jù)暫存    Dim Counter As Intege

18、r                                                  

19、;        ' 接收數(shù)據(jù)個(gè)數(shù)計(jì)數(shù)器    Dim i As Integer                                  &#

20、160;                             ' 循環(huán)變量        If (MSComm.InBufferCount > 0) Then       

21、 Counter = MSComm.InBufferCount                                             

22、; ' 讀取接收數(shù)據(jù)個(gè)數(shù)        receiveData = ""                                    

23、;                        ' 清緩沖                ReceiveArr = MSComm.Input      

24、0;                                            ' 數(shù)據(jù)放入數(shù)組    

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

26、; ' 數(shù)據(jù)格式處理            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、                         ' 顯示接收的十六進(jìn)制數(shù)據(jù)        TxtReceive.SelStart = Len(TxtReceive.Text)         

30、;                         ' 顯示光標(biāo)位置    End If        ReceiveCount = ReceiveCount + Counter       

31、                                    ' 接收計(jì)數(shù)    txtRXcount.Text = "RX:" & ReceiveCount &#

32、160;                                        ' 接收字節(jié)數(shù)顯示        If chkauto

33、clear.Value = 1 Then                                              

34、0;   ' 自動(dòng)清空判斷        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;                 ' 發(fā)送數(shù)據(jù)長度    Dim outData As String                         

37、;                                  ' 發(fā)送數(shù)據(jù)暫存    Dim SendArr() As Byte        

38、                                                  

39、 ' 發(fā)送數(shù)組    Dim TemporarySave As String                                        

40、60;            ' 數(shù)據(jù)暫存    Dim dataCount As Integer                             

41、60;                          ' 數(shù)據(jù)個(gè)數(shù)計(jì)數(shù)    Dim i As Integer                

42、60;                                               ' 局部變量 

43、0;      outData = UCase(Replace(txtsend.Text, Space(1), Space(0)                        ' 先去掉空格，再轉(zhuǎn)換為大寫字母    outData = UCase(outData)  &#

44、160;                                                 &#

45、160;   ' 轉(zhuǎn)換成大寫    outputLen = Len(outData)                                      &

46、#160;                 ' 數(shù)據(jù)長度        For i = 0 To outputLen        TemporarySave = Mid(outData, i + 1, 1)        

47、;                              ' 取一位數(shù)據(jù)        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;                                  ' 判斷十六進(jìn)制數(shù)據(jù)是否為雙數(shù)        dataCount = dataCount - 1 

51、60;                                                 ' 不是

52、雙數(shù)，則減1    End If        outData = Left(outData, dataCount)                                 

53、;             ' 取出有效的十六進(jìn)制數(shù)據(jù)        ReDim SendArr(dataCount / 2 - 1)                       &

54、#160;                        ' 重新定義數(shù)組長度    For i = 0 To dataCount / 2 - 1        SendArr(i) = Val("&H" + Mid(outData,

55、 i * 2 + 1, 2)                         ' 取出數(shù)據(jù)轉(zhuǎn)換成十六進(jìn)制并放入數(shù)組中    Next        SendCount = SendCount + (dataCount / 2)   

56、                                      ' 計(jì)算總發(fā)送數(shù)    txtTXcount.Text = "TX:" & SendCo

57、unt             MSComm.Output = SendArr                                  &#

58、160;                      ' 發(fā)送數(shù)據(jù)End SubPrivate Sub OpenCom() '打開串口On Error GoTo Err    If MSComm.PortOpen = True Then MSComm.PortOpen = False     &

59、#160;                    ' 先判斷串口是否打開，如果打開則先關(guān)閉            Call Comm_reSet(Val(Mid(cbocom.Text, 4, 1), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbod

60、atabit.Text, cbostopbit.Text)             ' 串口設(shè)置        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 = "關(guān)閉串口"        mnuconnect.Capt

62、ion = "disconnect"        'ImgSwitch.Picture = LoadPicture("f:我的VB串口調(diào)試軟件圖片kai.jpg")      ' 顯示串口已經(jīng)打開的圖標(biāo)        ImgSwitchon.Visible = True       

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

64、60;        ' 串口狀態(tài)顯示        cmdswitch.Caption = "打開串口"        mnuconnect.Caption = "connect"        'ImgSwitch.Picture = LoadPicture(

65、"f:我的VB串口調(diào)試軟件圖片guan.jpg")     ' 顯示串口已經(jīng)關(guān)閉的圖標(biāo)        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)        ' 計(jì)算總接收數(shù)據(jù)    If DisplaySwitch = False Then        

67、                                          ' 顯示接收文本       

68、; TxtReceive.Text = TxtReceive.Text & InputSignal                            ' 單片機(jī)內(nèi)存的值用TextReceive顯示出        TxtReceive.Se

69、lStart = Len(TxtReceive.Text)                                 ' 顯示光標(biāo)位置    End If    txtRXcount.Text = &quo

70、t;RX:" & ReceiveCount                                         ' 接收字節(jié)數(shù)顯示  

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

72、160;       ' 自動(dòng)清空判斷        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;                                        ' 發(fā)送文件    Else     

75、   OutputSignal = txtsend.Text                                           &#

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

77、計(jì)算總發(fā)送數(shù)    txtTXcount.Text = "TX:" & SendCount                                     

78、0;       ' 發(fā)送字節(jié)數(shù)顯示Err:            End SubPrivate Sub Image1_Click()End Sub Private Sub mnuautosend_Click()On Error GoTo Err    'If TmrAutoSend.Enabled = True Then    &

79、#160;                                              ' 如果有效則，自動(dòng)發(fā)送 &#

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

81、#160;      ' 串口狀態(tài)判斷            ChkAutoSend.Value = 1            TmrAutoSend.Interval = Val(TxtAutoSendTime)         

82、                    ' 設(shè)置自動(dòng)發(fā)送時(shí)間            mnuautosend.Caption = "取消自動(dòng)發(fā)送"          

83、0; TmrAutoSend.Enabled = True                                             

84、' 打開自動(dòng)發(fā)送定時(shí)器        Else                mnuautosend.Caption = "自動(dòng)發(fā)送"            ChkAutoSend.Value = 0   

85、60;                                               ' 串口沒有打開去掉自動(dòng)發(fā)送&#

86、160;           MsgBox "串口沒有打開，請(qǐng)打開串口", 48, "串口調(diào)試助手"                   ' 如果串口沒有被打開，提示打開串口        End If

87、    'ElseIf TmrAutoSend.Enabled = False Then                                       

88、60;       ' 如果無效，不發(fā)送    '        mnuautosend.Caption = "autosend"     '      TmrAutoSend.Enabled = False        &

89、#160;                                    ' 關(guān)閉自動(dòng)發(fā)送定時(shí)器    '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"                                  ' 串口狀態(tài)顯示     

101、60;  cmdswitch.Caption = "打開串口"                'ImgSwitch.Picture = LoadPicture("f:我的VB串口調(diào)試軟件圖片guan.jpg")     ' 顯示串口已經(jīng)關(guān)閉的圖標(biāo)        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 = "關(guān)閉串口"                'ImgSwitch.Picture = LoadPicture("f:我的VB串口調(diào)試軟件圖

105、片kai.jpg")      ' 顯示串口已經(jīng)打開的圖標(biāo)        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;             ' 錯(cuò)誤處理    SaveTextPath = txtsavepath                            &#

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

112、;                         ' 打開文件                        

113、                                                  

114、          ' 不存在的話 會(huì)創(chuàng)建文件,如已存在 會(huì)覆蓋                                    

115、60;                                               ' output 改為appen

116、d 為追加                                                 &

117、#160;                                  ' 改為input 則只讀    Print #1, Year(Date) & "年" & Month(Date) &

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

119、;                                ' 把接收區(qū)的文本保存 文本前加上保存時(shí)間 （0000年00月00日00時(shí)00分00秒）          

120、0;                                                 

121、0;                       ' vbcrlf 為回車換行    Close #1                    

122、                                                  

123、  ' 關(guān)閉文件        txtsavepath = "OK,1.txt Save"                                  &#

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

125、60;                                                 

126、60;  ' 記下開始的時(shí)間    While Timer < Savetime + 5                                      &

127、#160;               ' 循環(huán)等待 5 - 要延時(shí)的時(shí)間        DoEvents                       

128、                                             ' 轉(zhuǎn)讓控制權(quán)，以便讓操作系統(tǒng)處理其它的事件。 &#

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個(gè)數(shù)就觸發(fā)一次   &

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

133、#160;                                           ' 十六進(jìn)制接收     

134、       Else                Call textReceive                         &#

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

136、#160;    Case comEvSend                                           

137、0;                  ' 每發(fā)送1個(gè)數(shù)就觸發(fā)一次            If ChkHexsend.Value = 1 Then            Else  

138、              Call textSend                                  

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