Dim OutputAscii As Boolean
Dim InputString As String
Dim OutputString As String
'=====================================================================================
' 變量定義
'=====================================================================================
Option Explicit ' 強制顯式聲明
Dim ComSwitch As Boolean ' 串口開關狀態判斷
Dim FileData As String ' 要發送的文件暫存
Dim SendCount As Long ' 發送數據字節計數器
Dim ReceiveCount As Long ' 接收數據字節計數器
Dim InputSignal As String ' 接收緩衝暫存
Dim OutputSignal As String ' 發送數據暫存
Dim DisplaySwitch As Boolean ' 顯示開關
Dim ModeSend As Boolean ' 發送方式判斷
Dim Savetime As Single ' 時間數據暫存 延時用
Dim SaveTextPath As String ' 保存文本路徑
' 網頁超鏈接申明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "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 Long
Private Sub CloseCom() '關閉串口
On Error GoTo Err
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關閉
txtstatus.Text = "STATUS：COM Port Cloced" ' 串口狀態顯示
mnuconnect.Caption = "斷開串口"
cmdswitch.Caption = "打開串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口調試軟件\圖片\guan.jpg") ' 顯示串口已經關閉的圖標
ImgSwitchoff.Visible = True
ImgSwitchon.Visible = False
Err:
End Sub
Private Sub UpdateStatus()
If MSComm.PortOpen Then
StatusBar1.Panels(1).Text = "Connected"
mnuautosend.Caption = "自動發送"
mnuconnect.Caption = "斷開串口"
Else
StatusBar1.Panels(1).Text = "斷開串口"
mnuautosend.Caption = "disautosend"
mnuconnect.Caption = "打開串口"
End If
StatusBar1.Panels(2).Text = "COM" & MSComm.CommPort
StatusBar1.Panels(3).Text = MSComm.Settings
If (OutputAscii) Then
StatusBar1.Panels(4) = "ASCII"
Else
StatusBar1.Panels(4) = "HEX"
End If
'
On Error GoTo Err
If ChkAutoSend.Value = 1 Then ' 如果有效則，自動發送
If MSComm.PortOpen = True Then ' 串口狀態判斷
mnuautosend.Caption = "Dis&autosend"
TmrAutoSend.Interval = Val(TxtAutoSendTime) ' 設置自動發送時間
TmrAutoSend.Enabled = True ' 打開自動發送定時器
Else
mnuautosend.Caption = "autosend"
ChkAutoSend.Value = 0 ' 串口沒有打開去掉自動發送
MsgBox "串口沒有打開，請打開串口", 48, "串口調試助手" ' 如果串口沒有被打開，提示打開串口
End If
ElseIf ChkAutoSend.Value = 0 Then ' 如果無效，不發送
mnuautosend.Caption = "autosend"
TmrAutoSend.Enabled = False ' 關閉自動發送定時器
End If
Err:
End Sub
Private Sub CmdSendFile_Click() '發送文件
On Error GoTo Err
If MSComm.PortOpen = True Then ' 如果串口打開了，則可以發送數據
If FileData = "" Then ' 判斷髮送數據是否爲空
MsgBox "發送的文件爲空", 16, "串口調試助手" ' 發送數據爲空則提示
Else
If ChkHexReceive.Value = 1 Then ' 如果按十六進制接收時，按二進制發送，否則按文本發送
MSComm.InputMode = comInputModeBinary ' 二進制發送
Else
MSComm.InputMode = comInputModeText ' 文本發送
End If
MSComm.Output = Trim(FileData) ' 發送數據
ModeSend = True ' 設置文本發送方式
End If
Else
MsgBox "串口沒有打開，請打開串口", 48, "串口調試助手" ' 如果串口沒有被打開，提示打開串口
End If
Err:
End Sub
Private Sub Comm_initial(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer, StopBit As Integer)
On Error GoTo ErrorTrap ' 錯誤則跳往錯誤處理
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關閉
MSComm.CommPort = Port ' 設定端口
MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 設置波特率，無校驗，8位數據位，1位停止位
MSComm.InBufferSize = 1024 ' 設置接收緩衝區爲1024字節
MSComm.OutBufferSize = 4096 ' 設置發送緩衝區爲4096字節
MSComm.InBufferCount = 0 ' 清空輸入緩衝區
MSComm.OutBufferCount = 0 ' 清空輸出緩衝區
MSComm.SThreshold = 1 ' 發送緩衝區空觸發發送事件
MSComm.RThreshold = 1 ' 每X個字符到接收緩衝區引起觸發接收事件
MSComm.OutBufferCount = 0 ' 清空發送緩衝區
MSComm.InBufferCount = 0 ' 滑空接收緩衝
MSComm.PortOpen = True ' 打開串口
If MSComm.PortOpen = True Then
txtstatus.Text = "STATUS：" & cbocom.Text & " OPEND，" & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1) & "," & cbodatabit.Text & "," & cbostopbit.Text
Else
txtstatus.Text = "STATUS：COM Port Cloced" ' 串口沒打開時，提示串口關閉狀態
End If
Exit Sub
ErrorTrap: ' 錯誤處理
Select Case Err.Number
Case comPortAlreadyOpen ' 如果串口已經打開，則提示
MsgBox "沒有發現此串口或被佔用", 49, "串口調試助手"
CloseCom
Case Else
MsgBox "沒有發現此串口或被佔用", 49, "串口調試助手"
CloseCom
End Select
Err.Clear
End Sub
Private Sub Comm_reSet(Port As Byte, BaudRate As String, ParityBit As String, DataBit As Integer, StopBit As Integer)
On Error GoTo ErrorHint ' 錯誤則跳往錯誤處理
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關閉
MSComm.CommPort = Port ' 設定端口
MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 設置波特率，無校驗，8位數據位，1位停止位
MSComm.PortOpen = True ' 打開串口
If MSComm.PortOpen = True Then
cmdswitch.Caption = "關閉串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口調試軟件\圖片\kai.jpg") ' 顯示串口已經打開的圖標
ImgSwitchoff.Visible = False
mnuconnect.Caption = "disconnect"
ImgSwitchon.Visible = True
txtstatus.Text = "STATUS：" & cbocom.Text & " OPEND，" & cbobaudrate.Text & "," & Left(cboparitybit.Text, 1) & "," & cbodatabit.Text & "," & cbostopbit.Text
Else
cmdswitch.Caption = "打開串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口調試軟件\圖片\guan.jpg") ' 顯示串口已經關閉的圖標
ImgSwitchon.Visible = False
ImgSwitchoff.Visible = True
txtstatus.Text = "STATUS：COM Port Cloced"
End If
Exit Sub
ErrorHint: ' 錯誤處理
Select Case Err.Number
Case comPortAlreadyOpen ' 如果串口已經打開，則提示
MsgBox "沒有成功，請重試", vbExclamation, "串口調試助手"
CloseCom ' 調用關閉串口函數
Case Else
MsgBox "沒有成功，請重試", vbExclamation, "串口調試助手"
CloseCom ' 調用關閉串口函數
End Select
Err.Clear ' 清除 Err 對象的屬性
End Sub
Private Sub Command1_Click()
End Sub
Private Sub cbobaudrate_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口設置
End Sub
Private Sub cbocom_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口設置
End Sub
Private Sub cbodatabit_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口設置
End Sub
Private Sub cboparitybit_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口設置
End Sub
Private Sub cbostopbit_Change()
Call Comm_reSet(Val(Mid(cbocom.Text, 4, 2)), cbobaudrate.Text, Left(cboparitybit.Text, 1), cbodatabit.Text, cbostopbit.Text) '串口設置
End Sub
Private Sub chkautosend_Click()
On Error GoTo Err
If ChkAutoSend.Value = 1 Then ' 如果有效則，自動發送
If MSComm.PortOpen = True Then ' 串口狀態判斷
mnuautosend.Caption = "取消自動發送"
TmrAutoSend.Interval = Val(TxtAutoSendTime) ' 設置自動發送時間
TmrAutoSend.Enabled = True ' 打開自動發送定時器
Else
ChkAutoSend.Value = 0 ' 串口沒有打開去掉自動發送
MsgBox "串口沒有打開，請打開串口", 48, "串口調試助手" ' 如果串口沒有被打開，提示打開串口
End If
ElseIf ChkAutoSend.Value = 0 Then ' 如果無效，不發送
mnuautosend.Caption = "自動發送數據"
TmrAutoSend.Enabled = False ' 關閉自動發送定時器
End If
Err:
End Sub
Private Sub cmdamend_Click()
Dim spShell As Object ' 定義存放引用對象的變量
Dim spFolder As Object ' 定義存放引用對象的變量
Dim spFolderItem As Object ' 定義存放引用對象的變量
Dim spPath As String ' 定義存放的變量
On Error GoTo Err ' 錯誤處理，防止取消打開文件夾時報錯
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set spShell = CreateObject("Shell.Application")
Set spFolder = spShell.BrowseForFolder(WINDOW_HANDLE, "選擇目錄:", NO_OPTIONS, "C:\Scripts")
Set spFolderItem = spFolder.Self
spPath = spFolderItem.Path
spPath = Replace(spPath, "\", "\") ' Replace函數的返回值是一個字符串
txtsavepath.Text = spPath ' 把文件夾路徑顯示在標籤上
SaveTextPath = txtsavepath.Text ' 路徑暫存
Err:
End Sub
Private Sub CmdClearCounter_Click()
On Error GoTo Err
SendCount = 0 ' 發送計數器清零
ReceiveCount = 0 ' 接收計數器清零
txtRXcount.Text = "RX:" & 0 ' 接收計數
txtTXcount.Text = "TX:" & 0 ' 發送計數
Err:
End Sub
Private Sub cmdclearrecieve_Click()
TxtReceive.Text = ""
End Sub
Private Sub cmdclearsend_Click()
txtsend.Text = ""
End Sub
Private Sub CmdHelp_Click()
FrmHelp.Show
End Sub
Private Sub CmdQuit_Click()
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關閉
Unload Me ' 卸載窗體，並退出程序
End
End Sub
Private Sub cmdsavedisp_Click()
On Error GoTo Err ' 錯誤處理
SaveTextPath = txtsavepath ' 路徑暫存
Open txtsavepath & "\1.txt" For Output As #1 ' 打開文件
' 不存在的話 會創建文件,如已存在 會覆蓋
' output 改爲append 爲追加
' 改爲input 則只讀
Print #1, Year(Date) & "年" & Month(Date) & "月" & Day(Date) & _
"日" & Hour(Time) & "時" & Minute(Time) & "分" & Second(Time) & _
"秒" & vbCrLf & TxtReceive.Text + vbCrLf ' 把接收區的文本保存 文本前加上保存時間 （0000年00月00日00時00分00秒）
' vbcrlf 爲回車換行
Close #1 ' 關閉文件
txtsavepath = "OK,1.txt Save" ' 提示保存成功
cmdsavedisp.Enabled = False
Savetime = Timer ' 記下開始的時間
While Timer < Savetime + 5 ' 循環等待 5 - 要延時的時間
DoEvents ' 轉讓控制權，以便讓操作系統處理其它的事件。
Wend
txtsavepath = SaveTextPath ' 顯示保存路徑
cmdsavedisp.Enabled = True
Err:
End Sub
'=====================================================================================
' 選擇要發送的文件並放入內存中
'=====================================================================================
Private Sub CmdSelectFile_Click() ' 選擇要發送的文件
On Error GoTo Err ' 錯誤處理
CommonDialog1.Flags = cdlCFBoth
CommonDialog1.ShowOpen
TxtSendPath.Text = CommonDialog1.FileName ' 把打開的文件名給於TxtSendPath
Open TxtSendPath.Text For Input As 1 ' 打開選擇的文件
FileData = StrConv(InputB$(LOF(1), 1), vbUnicode) ' 顯示打開的文件
Close 1 ' 關閉文件
Err:
End Sub
Private Sub cmdsend_Click()
On Error GoTo Err
If MSComm.PortOpen = True Then ' 如果串口打開了，則可以發送數據
If txtsend.Text = "" Then ' 判斷髮送數據是否爲空
MsgBox "發送數據不能爲空", 16, "串口調試助手" ' 發送數據爲空則提示
Else
If ChkHexsend.Value = 1 Then ' 發送方式判斷
MSComm.InputMode = comInputModeBinary ' 二進制發送
Call hexSend ' 發送十六進制數據
Else ' 按十六進制接收文本方式發送的數據時，文本也要按二進制發送發送
If ChkHexReceive.Value = 1 Then
MSComm.InputMode = comInputModeBinary ' 二進制發送
Else
MSComm.InputMode = comInputModeText ' 文本發送
End If
MSComm.Output = Trim(txtsend.Text) ' 發送數據
ModeSend = False ' 設置文本發送方式
End If
End If
Else
MsgBox "串口沒有打開，請打開串口", 48, "串口調試助手" ' 如果串口沒有被打開，提示打開串口
End If
Err:
End Sub
Private Sub cmdstopdisp_Click()
On Error GoTo Err
If DisplaySwitch = False Then
DisplaySwitch = True ' 關閉顯示
cmdstopdisp.Caption = "繼續顯示"
Else
DisplaySwitch = False ' 開啓顯示
cmdstopdisp.Caption = "停止顯示"
End If
Err:
End Sub