經(jīng)典的串口調(diào)試助手源代碼

1、 Dim OutputAscii As BooleanDim InputString As StringDim OutputString As String'= =' 變量定義'= =Option Explicit ' 強(qiáng)制顯式聲明Dim ComSwitch As Boolean ' 串口開關(guān)狀態(tài)判斷Dim FileData As String ' 要發(fā)送的文件暫存Dim SendCount As Long ' 發(fā)送數(shù)據(jù)字節(jié)計(jì)數(shù)器Dim ReceiveCount As Long ' 接收數(shù)據(jù)字節(jié)計(jì)數(shù)器Dim InputSignal

2、 As String ' 接收緩沖暫存Dim OutputSignal As String ' 發(fā)送數(shù)據(jù)暫存Dim DisplaySwitch As Boolean ' 顯示開關(guān)Dim ModeSend As Boolean ' 發(fā)送方式判斷Dim Savetime As Single ' 時(shí)間數(shù)據(jù)暫存 延時(shí)用Dim SaveTextPath As String ' 保存文本路徑' 網(wǎng)頁超鏈接申明Private Declare Function ShellExecute Lib "shell32.dll" Alias

3、"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long As LongPrivate Sub CloseCom( ' 關(guān)閉串口On Error GoTo ErrIf MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先

4、判斷串口是否打 開,如果打開則先關(guān)閉txtstatus.Text = "STATUS:COM Port Cloced" ' 串口狀態(tài)顯示mnuconnect.Caption = "斷開串口 "cmdswitch.Caption = "打開串口 "'ImgSwitch.Picture = LoadPicture("f:我的 VB串口調(diào)試軟件 圖片 guan.jpg" ' 顯示串口已經(jīng)關(guān)閉 的圖標(biāo)ImgSwitchoff.Visible = TrueImgSwitchon.Visible = F

5、alseErr:End SubPrivate Sub UpdateStatus(If MSComm.PortOpen ThenStatusBar1.Panels(1.Text = "Connected"mnuautosend.Caption = "自動(dòng)發(fā)送 "mnuconnect.Caption = "斷開串口 "ElseStatusBar1.Panels(1.Text = "斷開串口 "mnuautosend.Caption = "disautosend"mnuconnect.Caption

6、= "打開串口 "End IfStatusBar1.Panels(2.Text = "COM" & MSComm.CommPortStatusBar1.Panels(3.Text = MSComm.SettingsIf (OutputAscii ThenStatusBar1.Panels(4 = "ASCII"ElseStatusBar1.Panels(4 = "HEX"End If'On Error GoTo ErrIf ChkAutoSend.Value = 1 Then ' 如果有效則

7、,自動(dòng)發(fā)送If MSComm.PortOpen = True Then ' 串口狀態(tài)判斷mnuautosend.Caption = "Dis&autosend"TmrAutoSend.Interval = Val(TxtAutoSendTime ' 設(shè)置自動(dòng)發(fā)送時(shí)間TmrAutoSend.Enabled = True ' 打開自動(dòng)發(fā)送定時(shí)器Elsemnuautosend.Caption = "autosend"ChkAutoSend.Value = 0 ' 串口沒有打開去掉自動(dòng)發(fā)送MsgBox "串口沒有

8、打開,請打開串口 ", 48, "串口調(diào)試助手 " ' 如果串口沒有被打開,提 示打開串口End IfElseIf ChkAutoSend.Value = 0 Then ' 如果無效,不發(fā)送mnuautosend.Caption = "autosend"TmrAutoSend.Enabled = False ' 關(guān)閉自動(dòng)發(fā)送定時(shí)器End IfErr:End SubPrivate Sub CmdSendFile_Click( '發(fā)送文件On Error GoTo ErrIf MSComm.PortOpen = Tr

9、ue Then ' 如果串口打開了,則可以發(fā)送數(shù) 據(jù)If FileData = "" Then ' 判斷發(fā)送數(shù)據(jù)是否為空MsgBox "發(fā)送的文件為空 ", 16, "串口調(diào)試助手 " ' 發(fā)送數(shù)據(jù)為空則提示ElseIf ChkHexReceive.Value = 1 Then ' 如果按十六進(jìn)制接收時(shí),按二進(jìn)制 發(fā)送,否則按文本發(fā)送MSComm.InputMode = comInputModeBinary ' 二進(jìn)制發(fā)送ElseMSComm.InputMode = comInputModeTe

10、xt ' 文本發(fā)送End IfMSComm.Output = Trim(FileData ' 發(fā)送數(shù)據(jù)ModeSend = True ' 設(shè)置文本發(fā)送方式End IfElseMsgBox "串口沒有打開,請打開串口 ", 48, "串口調(diào)試助手 " ' 如果串口沒有被打開,提 示打開串口End IfErr:End SubPrivate Sub Comm_initial(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer, Sto

11、pBit As IntegerOn Error GoTo ErrorTrap ' 錯(cuò)誤則跳往錯(cuò)誤處理If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打 開,如果打開則先關(guān)閉MSComm.CommPort = Port ' 設(shè)定端口MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit &#

12、39; 設(shè)置波特率,無校 驗(yàn), 8位數(shù)據(jù)位, 1位停止位MSComm.InBufferSize = 1024 ' 設(shè)置接收緩沖區(qū)為 1024字節(jié) MSComm.OutBufferSize = 4096 ' 設(shè)置發(fā)送緩沖區(qū)為 4096字節(jié) MSComm.InBufferCount = 0 ' 清空輸入緩沖區(qū)MSComm.OutBufferCount = 0 ' 清空輸出緩沖區(qū)MSComm.SThreshold = 1 ' 發(fā)送緩沖區(qū)空觸發(fā)發(fā)送事件MSComm.RThreshold = 1 ' 每 X 個(gè)字符到接收緩沖區(qū)引起觸發(fā)接 收事件MSComm

13、.OutBufferCount = 0 ' 清空發(fā)送緩沖區(qū)MSComm.InBufferCount = 0 ' 滑空接收緩沖MSComm.PortOpen = True ' 打開串口If MSComm.PortOpen = True Thentxtstatus.Text = "STATUS :" & cbocom.Text & " OPEND , " & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1 & &q

14、uot;," & cbodatabit.Text & "," & cbostopbit.TextElsetxtstatus.Text = "STATUS:COM Port Cloced" ' 串口沒打開時(shí),提示串口關(guān)閉 狀態(tài)End IfExit SubErrorTrap: ' 錯(cuò)誤處理Select Case Err.NumberCase comPortAlreadyOpen ' 如果串口已經(jīng)打開,則提示MsgBox "沒有發(fā)現(xiàn)此串口或被占用 ", 49, "串口調(diào)試助

15、手 "CloseComCase ElseMsgBox "沒有發(fā)現(xiàn)此串口或被占用 ", 49, "串口調(diào)試助手 "CloseComEnd SelectErr.ClearEnd SubPrivate Sub Comm_reSet(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer,StopBit As IntegerOn Error GoTo ErrorHint ' 錯(cuò)誤則跳往錯(cuò)誤處理If MSComm.PortOpen = True Then

16、MSComm.PortOpen = False ' 先判斷串口是否打 開,如果打開則先關(guān)閉MSComm.CommPort = Port ' 設(shè)定端口MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 設(shè)置波特率,無校 驗(yàn), 8位數(shù)據(jù)位, 1位停止位MSComm.PortOpen = True ' 打開串口If MSComm.PortOpen = Tru

17、e Thencmdswitch.Caption = "關(guān)閉串口 "'ImgSwitch.Picture = LoadPicture("f:我的 VB串口調(diào)試軟件 圖片 kai.jpg" ' 顯示串口已經(jīng)打開的 圖標(biāo)ImgSwitchoff.Visible = Falsemnuconnect.Caption = "disconnect"ImgSwitchon.Visible = Truetxtstatus.Text = "STATUS :" & cbocom.Text & "

18、 OPEND , " & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1 & "," & cbodatabit.Text & "," & cbostopbit.TextElsecmdswitch.Caption = "打開串口 "'ImgSwitch.Picture = LoadPicture("f:我的 VB串口調(diào)試軟件 圖片 guan.jpg" ' 顯示串口

19、已經(jīng)關(guān)閉 的圖標(biāo)ImgSwitchon.Visible = FalseImgSwitchoff.Visible = Truetxtstatus.Text = "STATUS:COM Port Cloced"End IfExit SubErrorHint: ' 錯(cuò)誤處理Select Case Err.NumberCase comPortAlreadyOpen ' 如果串口已經(jīng)打開,則提示MsgBox "沒有成功,請重試 ", vbExclamation, "串口調(diào)試助手 "CloseCom ' 調(diào)用關(guān)閉串口函數(shù)C

20、ase ElseMsgBox "沒有成功,請重試 ", vbExclamation, "串口調(diào)試助手 "CloseCom ' 調(diào)用關(guān)閉串口函數(shù)End SelectErr.Clear ' 清除 Err 對象的屬性End SubPrivate Sub Command1_Click(End SubPrivate Sub cbobaudrate_Change(Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2, cbobaudrate.Text, Left(cboparitybit.Text, 1, cbodata

21、bit.Text, cbostopbit.Text ' 串口設(shè)置End SubPrivate Sub cbocom_Change(Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2, cbobaudrate.Text, Left(cboparitybit.Text, 1, cbodatabit.Text, cbostopbit.Text ' 串口設(shè)置End SubPrivate Sub cbodatabit_Change(Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2, cbobaudrate.Text, Le

22、ft(cboparitybit.Text, 1, cbodatabit.Text, cbostopbit.Text ' 串口設(shè)置End SubPrivate Sub cboparitybit_Change(Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2, cbobaudrate.Text, Left(cboparitybit.Text, 1, cbodatabit.Text, cbostopbit.Text ' 串口設(shè)置End SubPrivate Sub cbostopbit_Change(Call Comm_reSet(Val(Mid(c

23、bocom.Text, 4, 2, cbobaudrate.Text, Left(cboparitybit.Text, 1, cbodatabit.Text, cbostopbit.Text ' 串口設(shè)置End SubPrivate Sub chkautosend_Click(On Error GoTo ErrIf ChkAutoSend.Value = 1 Then ' 如果有效則,自動(dòng)發(fā)送If MSComm.PortOpen = True Then ' 串口狀態(tài)判斷mnuautosend.Caption = "取消自動(dòng)發(fā)送 "TmrAutoSen

24、d.Interval = Val(TxtAutoSendTime ' 設(shè)置自動(dòng)發(fā)送時(shí)間TmrAutoSend.Enabled = True ' 打開自動(dòng)發(fā)送定時(shí)器ElseChkAutoSend.Value = 0 ' 串口沒有打開去掉自動(dòng)發(fā)送MsgBox "串口沒有打開,請打開串口 ", 48, "串口調(diào)試助手 " ' 如果串口沒有被打開,提 示打開串口End IfElseIf ChkAutoSend.Value = 0 Then ' 如果無效,不發(fā)送mnuautosend.Caption = "自動(dòng)發(fā)送

25、數(shù)據(jù) "TmrAutoSend.Enabled = False ' 關(guān)閉自動(dòng)發(fā)送定時(shí)器End IfErr:End SubPrivate Sub cmdamend_Click(Dim spShell As Object ' 定義存放引用對象的變量Dim spFolder As Object ' 定義存放引用對象的變量Dim spFolderItem As Object ' 定義存放引用對象的變量Dim spPath As String ' 定義存放的變量On Error GoTo Err ' 錯(cuò)誤處理,防止取消打開文件夾時(shí)報(bào)錯(cuò) Const

26、 WINDOW_HANDLE = 0Const NO_OPTIONS = 0Set spShell = CreateObject("Shell.Application"Set spFolder = spShell.BrowseForFolder(WINDOW_HANDLE, " 選 擇 目 錄 :", NO_OPTIONS, "C:Scripts"Set spFolderItem = spFolder.SelfspPath = spFolderItem.PathspPath = Replace(spPath, ""

27、, "" ' Replace函數(shù)的返回值是一個(gè)字符串 txtsavepath.Text = spPath ' 把文件夾路徑顯示在標(biāo)簽上SaveTextPath = txtsavepath.Text ' 路徑暫存Err:End SubPrivate Sub CmdClearCounter_Click(On Error GoTo ErrSendCount = 0 ' 發(fā)送計(jì)數(shù)器清零ReceiveCount = 0 ' 接收計(jì)數(shù)器清零txtRXcount.Text = "RX:" & 0 ' 接收計(jì)數(shù)tx

28、tTXcount.Text = "TX:" & 0 ' 發(fā)送計(jì)數(shù)Err:End SubPrivate Sub cmdclearrecieve_Click(TxtReceive.Text = ""End SubPrivate Sub cmdclearsend_Click(txtsend.Text = ""End SubPrivate Sub CmdHelp_Click(FrmHelp.ShowEnd SubPrivate Sub CmdQuit_Click(If MSComm.PortOpen = True Then M

29、SComm.PortOpen = False ' 先判斷串口是否打 開,如果打開則先關(guān)閉Unload Me ' 卸載窗體,并退出程序EndEnd SubPrivate Sub cmdsavedisp_Click(On Error GoTo Err ' 錯(cuò)誤處理SaveTextPath = txtsavepath ' 路徑暫存Open txtsavepath & "1.txt" For Output As #1 ' 打開文件' 不存在的話 會(huì)創(chuàng)建文件 , 如已存在 會(huì)覆蓋' output 改為 append 為追

30、加' 改為 input 則只讀Print #1, Year(Date & "年 " & Month(Date & "月 " & Day(Date & _" 日 " & Hour(Time & "時(shí) " & Minute(Time & "分 " & Second(Time & _" 秒 " & vbCrLf & TxtReceive.Text + vbCrLf 

31、9; 把接收區(qū)的文本保存 文本前加上 保存時(shí)間 (0000年 00月 00日 00時(shí) 00分 00秒' vbcrlf 為回車換行Close #1 ' 關(guān)閉文件txtsavepath = "OK,1.txt Save" ' 提示保存成功cmdsavedisp.Enabled = FalseSavetime = Timer ' 記下開始的時(shí)間While Timer < Savetime + 5 ' 循環(huán)等待 5 - 要延時(shí)的時(shí)間DoEvents ' 轉(zhuǎn)讓控制權(quán),以便讓操作系統(tǒng)處理其它的事 件。Wendtxtsavepath

32、= SaveTextPath ' 顯示保存路徑cmdsavedisp.Enabled = TrueErr:End Sub'= =' 選擇要發(fā)送的文件并放入內(nèi)存中'= =Private Sub CmdSelectFile_Click( ' 選擇要發(fā)送的文件On Error GoTo Err ' 錯(cuò)誤處理CommonDialog1.Flags = cdlCFBothCommonDialog1.ShowOpenTxtSendPath.Text = CommonDialog1.FileName ' 把 打 開 的 文 件 名 給 于 TxtSendPathOpen TxtSendPa