天天操母乳av免费的,偷柏自拍亚洲综合在线,精品光秀国产精品

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "mscomm32.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Begin VB.Form 串口調(diào)試軟件
BackColor = &H0091CACA&
BorderStyle = 1 'Fixed Single
Caption = "串口調(diào)試軟件V1.0"
ClientHeight = 6360
ClientLeft = 4020
ClientTop = 3120
ClientWidth = 10815
FillColor = &H0091CACA&
ForeColor = &H0091CACA&
Icon = "串口調(diào)試助手.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
Picture = "串口調(diào)試助手.frx":030A
ScaleHeight = 6360
ScaleWidth = 10815
Begin MSComDlg.CommonDialog CommonDialog1
Left = 8160
Top = 5880
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "文本文件（*.txt）|*.txt"
End
Begin VB.Timer TmrNowTime
Interval = 1000
Left = 1320
Top = 4320
End
Begin VB.Timer TmrAutoSend
Left = 7680
Top = 5880
End
Begin MSCommLib.MSComm MSComm
Left = 7080
Top = 5760
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.PictureBox Picture1
BackColor = &H00E0E0E0&
Height = 500
Left = 9360
Picture = "串口調(diào)試助手.frx":3EEC
ScaleHeight = 435
ScaleWidth = 435
TabIndex = 43
Top = 5850
Width = 500
End
Begin VB.TextBox TxtAutoSendTime
Height = 300
Left = 1320
TabIndex = 41
Text = "1000"
Top = 5730
Width = 660
End
Begin VB.CommandButton CmdAmend
Appearance = 0 'Flat
Caption = "更改"
Height = 300
Left = 1250
TabIndex = 37
Top = 3450
Width = 505
End
Begin VB.CommandButton CmdSaveDisp
Appearance = 0 'Flat
Caption = "保存顯示數(shù)據(jù)"
Height = 300
Left = 30
TabIndex = 36
Top = 3450
Width = 1225
End
Begin VB.CommandButton CmdHelp
Caption = "關(guān)于"
Height = 300
Left = 8760
TabIndex = 21
Top = 6050
Width = 505
End
Begin VB.CommandButton CmdQuit
Caption = "關(guān)閉程序"
Height = 495
Left = 9900
TabIndex = 20
Top = 5820
Width = 870
End
Begin VB.CommandButton CmdClearCounter
Caption = "計數(shù)清零"
Height = 300
Left = 6100
TabIndex = 19
Top = 6080
Width = 865
End
Begin VB.CommandButton CmdSendFile
Caption = "發(fā)送文件"
Height = 280
Left = 5580
TabIndex = 18
Top = 5700
Width = 900
End
Begin VB.TextBox TxtSendPath
Alignment = 2 'Center
BackColor = &H0091CACA&
Height = 270
Left = 3800
TabIndex = 17
Text = "還沒有選擇文件"
Top = 5740
Width = 1700
End
Begin VB.CommandButton CmdSelectFile
Caption = "選擇發(fā)送文件"
Height = 280
Left = 2520
TabIndex = 16
Top = 5700
Width = 1225
End
Begin VB.TextBox TxtTXCount
Alignment = 2 'Center
BackColor = &H0091CACA&
Height = 270
Left = 4680
TabIndex = 15
Text = "TX:0"
Top = 6080
Width = 1340
End
Begin VB.TextBox TxtRXCount
Alignment = 2 'Center
BackColor = &H0091CACA&
Height = 270
Left = 3340
TabIndex = 14
Text = "RX:0"
Top = 6080
Width = 1350
End
Begin VB.TextBox TxtStatus
Alignment = 2 'Center
BackColor = &H0091CACA&
Height = 270
Left = 260
TabIndex = 13
Top = 6080
Width = 3100
End
Begin VB.CheckBox ChkAutoSend
BackColor = &H0091CACA&
Caption = "Check4"
Height = 255
Left = 30
TabIndex = 12
Top = 5480
Width = 255
End
Begin VB.CheckBox ChkHexSend
BackColor = &H0091CACA&
Caption = "Check3"
Height = 255
Left = 30
TabIndex = 11
Top = 5160
Width = 255
End
Begin VB.CommandButton CmdSend
Caption = "手動發(fā)送"
Height = 300
Left = 1590
TabIndex = 10
Top = 5160
Width = 870
End
Begin VB.CommandButton CmdClearSend
Caption = "清空重填"
Height = 300
Left = 100
TabIndex = 9
Top = 4850
Width = 870
End
Begin VB.TextBox TxtSend
Height = 865
Left = 2560
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 4820
Width = 8225
End
Begin VB.TextBox TxtSavePath
BackColor = &H0091CACA&
Height = 270
Left = 60
TabIndex = 7
Text = "C:\COMDATA"
Top = 3760
Width = 1650
End
Begin VB.CheckBox ChkHexReceive
BackColor = &H0091CACA&
Caption = "Check2"
Height = 255
Left = 50
TabIndex = 6
Top = 3100
Width = 255
End
Begin VB.CheckBox ChkAutoClear
BackColor = &H0091CACA&
Caption = "Check1"
Height = 255
Left = 50
TabIndex = 5
Top = 2850
Width = 255
End
Begin VB.CommandButton CmdStopdisp
Caption = "停止顯示"
Height = 310
Left = 30
TabIndex = 4
Top = 2520
Width = 1050
End
Begin VB.CommandButton CmdClearReceive
Caption = "清空接收區(qū)"
Height = 310
Left = 30
TabIndex = 3
Top = 2190
Width = 1050
End
Begin VB.Frame Frame1
BackColor = &H0091CACA&
Height = 2200
Left = 0
TabIndex = 2
Top = -100
Width = 1650
Begin VB.ComboBox CboStopbit
Height = 300
ItemData = "串口調(diào)試助手.frx":7ACE
Left = 750
List = "串口調(diào)試助手.frx":7ADB
TabIndex = 26
Text = "1"
Top = 1300
Width = 800
End
Begin VB.ComboBox CboDatabit
Height = 300
ItemData = "串口調(diào)試助手.frx":7AEA
Left = 750
List = "串口調(diào)試助手.frx":7AFA
TabIndex = 25
Text = "8"
Top = 1000
Width = 800
End
Begin VB.ComboBox CboParitybit
Height = 300
ItemData = "串口調(diào)試助手.frx":7B0A
Left = 750
List = "串口調(diào)試助手.frx":7B1D
TabIndex = 24
Text = "NONE"
Top = 700
Width = 800
End
Begin VB.ComboBox CboBaudrate
Height = 300
ItemData = "串口調(diào)試助手.frx":7B3F
Left = 750
List = "串口調(diào)試助手.frx":7B6A
TabIndex = 23
Text = "9600"
Top = 400
Width = 800
End
Begin VB.ComboBox CboCom
Height = 300
ItemData = "串口調(diào)試助手.frx":7BC3
Left = 750
List = "串口調(diào)試助手.frx":7BF4
TabIndex = 22
Text = "COM1"
Top = 111
Width = 800
End
Begin VB.CommandButton CmdSwitch
Caption = "關(guān)閉串口"
Height = 440
Left = 720
TabIndex = 1
Top = 1740
Width = 870
End
Begin VB.Image ImgSwitchOn
Appearance = 0 'Flat
Height = 420
Left = 120
Picture = "串口調(diào)試助手.frx":7C58
Top = 1680
Width = 450
End
Begin VB.Image ImgSwitchOff
Height = 420
Left = 120
Picture = "串口調(diào)試助手.frx":B6F5
Top = 1680
Width = 450
End
Begin VB.Label Label8
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "停止位"
Height = 255
Left = 50
TabIndex = 33
Top = 1400
Width = 600
End
Begin VB.Label Label7
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "數(shù)據(jù)位"
Height = 255
Left = 50
TabIndex = 32
Top = 1080
Width = 600
End
Begin VB.Label Label6
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "校驗位"
Height = 255
Left = 50
TabIndex = 31
Top = 760
Width = 600
End
Begin VB.Label Label5
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "波特率"
Height = 255
Left = 50
TabIndex = 30
Top = 470
Width = 600
End
Begin VB.Label Label4
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "串口"
Height = 255
Left = 50
TabIndex = 29
Top = 160
Width = 600
End
End
Begin VB.TextBox TxtReceive
Height = 4750
Left = 1800
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 6
Width = 8990
End
Begin VB.Label LblWeb
BackColor = &H0091CACA&
Caption = "WEB"
ForeColor = &H008A7839&
Height = 220
Left = 8880
MouseIcon = "串口調(diào)試助手.frx":EE3B
TabIndex = 46
Top = 5760
Width = 300
End
Begin VB.Label LblNewDate
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "顯示日前"
Height = 255
Left = 240
TabIndex = 45
Top = 4440
Width = 1215
End
Begin VB.Label LblNowTime
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "當(dāng)前時間"
ForeColor = &H00000000&
Height = 195
Left = 240
TabIndex = 44
Top = 4200
Width = 1215
End
Begin VB.Label Label14
BackColor = &H0091CACA&
Caption = "毫秒"
Height = 255
Left = 2000
TabIndex = 42
Top = 5760
Width = 450
End
Begin VB.Label LblArtoSendCyc
BackColor = &H0091CACA&
Caption = "自動發(fā)送周期："
Height = 200
Left = 60
TabIndex = 40
Top = 5760
Width = 1270
End
Begin VB.Label LblAutoSend
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "自動發(fā)送(周期改變后重選)"
Height = 200
Left = 240
TabIndex = 39
Top = 5510
Width = 2215
End
Begin VB.Label Label11
Alignment = 2 'Center
BackColor = &H0091CACA&
Caption = "十六進(jìn)制發(fā)送"
Height = 200
Left = 240
TabIndex = 38
Top = 5200
Width = 1200
End
Begin VB.Label Label10
BackColor = &H0091CACA&
Caption = "十六進(jìn)制顯示"
Height = 200
Left = 330
TabIndex = 35
Top = 3140
Width = 1200
End
Begin VB.Label LblArtoclear
BackColor = &H0091CACA&
Caption = "自動清空"
Height = 200
Left = 330
TabIndex = 34
Top = 2870
Width = 800
End
Begin VB.Label LblSend
BackColor = &H0091CACA&
BorderStyle = 1 'Fixed Single
Caption = "發(fā)送的字符/數(shù)據(jù)"
Height = 270
Left = 1100
TabIndex = 28
Top = 4850
Width = 1420
End
Begin VB.Label LblReceive
BackColor = &H0091CACA&
BorderStyle = 1 'Fixed Single
Caption = "接收區(qū)"
Height = 255
Left = 1130
TabIndex = 27
Top = 2180
Width = 595
End
End
Attribute VB_Name = "串口調(diào)試軟件"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================================================================
' 變量定義
'=====================================================================================
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é)計數(shù)器
Dim ReceiveCount As Long ' 接收數(shù)據(jù)字節(jié)計數(shù)器
Dim InputSignal 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ù)據(jù)暫存延時用
Dim SaveTextPath As String ' 保存文本路徑
' 網(wǎng)頁超鏈接申明
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
'====================================================================================
' 自動發(fā)送選擇
'=====================================================================================
Private Sub ChkAutoSend_Click()
On Error GoTo Err
If ChkAutoSend.Value = 1 Then ' 如果有效則，自動發(fā)送
If MSComm.PortOpen = True Then ' 串口狀態(tài)判斷
TmrAutoSend.Interval = Val(TxtAutoSendTime) ' 設(shè)置自動發(fā)送時間
TmrAutoSend.Enabled = True ' 打開自動發(fā)送定時器
Else
ChkAutoSend.Value = 0 ' 串口沒有打開去掉自動發(fā)送
MsgBox "串口沒有打開，請打開串口", 48, "串口調(diào)試助手" ' 如果串口沒有被打開，提示打開串口
End If
ElseIf ChkAutoSend.Value = 0 Then ' 如果無效，不發(fā)送
TmrAutoSend.Enabled = False ' 關(guān)閉自動發(fā)送定時器
End If
Err:
End Sub
'=====================================================================================
' 超鏈接我的博客
'=====================================================================================
Private Sub LblWeb_Click() ' 單擊打開網(wǎng)站
ShellExecute Me.hwnd, "open", "http://blog.163.com/zhaojun_xf/", "", "", 5 ' 要打開的網(wǎng)站
End Sub
' 鼠標(biāo)移入 WEB 區(qū)
Private Sub LblWeb_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblWeb.ForeColor = &H8A7839 ' 鼠標(biāo)移入WEB時的顏色
LblWeb.MousePointer = 99 ' 鼠標(biāo)移入WEB時的鼠標(biāo)的現(xiàn)狀 ,小手型
'LblWeb.MouseIcon = LoadPicture("f:\我的VB\串口調(diào)試軟件\圖片\mouse.cur") ' 鼠標(biāo)形狀圖片
End Sub
' 鼠標(biāo)移出 WEB 區(qū)
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblWeb.ForeColor = vbBlue ' 鼠標(biāo)移出WEB時的顏色
Me.MousePointer = vbDefault ' 鼠標(biāo)移出WEB時的鼠標(biāo)的現(xiàn)狀即Me.MousePointer = 0
End Sub
'=====================================================================================
' 自動發(fā)送定時器
'=====================================================================================
Private Sub TmrAutoSend_Timer() ' 定時器
On Error GoTo Err
If TxtSend.Text = "" Then ' 判斷發(fā)送數(shù)據(jù)是否為空
ChkAutoSend.Value = 0 ' 關(guān)閉自動發(fā)送
MsgBox "發(fā)送數(shù)據(jù)不能為空", 16, "串口調(diào)試助手" ' 發(fā)送數(shù)據(jù)為空則提示
Else
If ChkHexSend.Value = 1 Then ' 發(fā)送方式判斷
MSComm.InputMode = comInputModeBinary ' 二進(jìn)制發(fā)送
Call hexSend ' 發(fā)送十六進(jìn)制數(shù)據(jù)
Else ' 按十六進(jìn)制接收文本方式發(fā)送的數(shù)據(jù)時，文本也要按二進(jìn)制發(fā)送發(fā)送
If ChkHexReceive.Value = 1 Then
MSComm.InputMode = comInputModeBinary ' 二進(jìn)制發(fā)送
Else
MSComm.InputMode = comInputModeText ' 文本發(fā)送
End If
MSComm.Output = Trim(TxtSend.Text) ' 發(fā)送數(shù)據(jù)
ModeSend = False ' 設(shè)置文本發(fā)送方式
End If
End If
Err:
End Sub
'=====================================================================================
' 窗體載入
'=====================================================================================
Private Sub Form_Load() ' 載入窗體
On Error GoTo Err
LblWeb.FontUnderline = True ' WEB上加下劃線
LblWeb.ForeColor = vbBlue ' 藍(lán)色顯示W(wǎng)EB
TxtSend.Text = "http://www.newxing.com/" ' 載入發(fā)送信息
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關(guān)閉
' 初始化串口
Call Comm_initial(Val(Mid(CboCom.Text, 4, 1)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text)
Err:
End Sub
'=====================================================================================
' 保存接收文本
'=====================================================================================
Private Sub CmdSaveDisp_Click() ' 保存顯示數(shù)據(jù)
On Error GoTo Err ' 錯誤處理
SaveTextPath = TxtSavePath ' 路徑暫存
Open TxtSavePath & "\1.txt" For Output As #1 ' 打開文件
' 不存在的話會創(chuàng)建文件,如已存在會覆蓋
' output 改為append 為追加
' 改為input 則只讀
Print #1, Year(Date) & "年" & Month(Date) & "月" & Day(Date) & _
"日" & Hour(Time) & "時" & Minute(Time) & "分" & Second(Time) & _
"秒" & vbCrLf & TxtReceive.Text + vbCrLf ' 把接收區(qū)的文本保存文本前加上保存時間（0000年00月00日00時00分00秒）
' vbcrlf 為回車換行
Close #1 ' 關(guān)閉文件
TxtSavePath = "OK,1.txt Save" ' 提示保存成功
CmdSaveDisp.Enabled = False
Savetime = Timer ' 記下開始的時間
While Timer < Savetime + 5 ' 循環(huán)等待 5 - 要延時的時間
DoEvents ' 轉(zhuǎn)讓控制權(quán)，以便讓操作系統(tǒng)處理其它的事件。
Wend
TxtSavePath = SaveTextPath ' 顯示保存路徑
CmdSaveDisp.Enabled = True
Err:
End Sub
'=====================================================================================
' 停止顯示
'=====================================================================================
Private Sub CmdStopdisp_Click()
On Error GoTo Err
If DisplaySwitch = False Then
DisplaySwitch = True ' 關(guān)閉顯示
CmdStopdisp.Caption = "繼續(xù)顯示"
Else
DisplaySwitch = False ' 開啟顯示
CmdStopdisp.Caption = "停止顯示"
End If
Err:
End Sub
'=====================================================================================
' 計數(shù)器清零
'=====================================================================================
Private Sub CmdClearCounter_Click() ' 清除計數(shù)器
On Error GoTo Err
SendCount = 0 ' 發(fā)送計數(shù)器清零
ReceiveCount = 0 ' 接收計數(shù)器清零
TxtRXCount.Text = "RX:" & 0 ' 接收計數(shù)
TxtTXCount.Text = "TX:" & 0 ' 發(fā)送計數(shù)
Err:
End Sub
'=====================================================================================
' 更改保存顯示數(shù)據(jù)的目錄
'=====================================================================================
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函數(shù)的返回值是一個字符串
TxtSavePath.Text = spPath ' 把文件夾路徑顯示在標(biāo)簽上
SaveTextPath = TxtSavePath.Text ' 路徑暫存
Err:
End Sub
'=====================================================================================
' 串口設(shè)置
'=====================================================================================
Private Sub CboBaudrate_Click() ' 修改波特率
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口設(shè)置
End Sub
Private Sub CboCom_Click() ' 修改串口
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口設(shè)置
End Sub
Private Sub CboDatabit_Click() ' 修改數(shù)據(jù)位
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口設(shè)置
End Sub
Private Sub CboParitybit_Click() ' 修改校驗位
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口設(shè)置
End Sub
Private Sub CboStopbit_Click() ' 修改停止位
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 2)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) '串口設(shè)置
End Sub
'=====================================================================================
' 清空數(shù)據(jù)
'=====================================================================================
Private Sub CmdClearSend_Click() ' 清除發(fā)送區(qū)
TxtSend.Text = ""
End Sub
Private Sub CmdClearReceive_Click() ' 清空接收區(qū)
TxtReceive.Text = ""
End Sub
'=====================================================================================
' 選擇要發(fā)送的文件并放入內(nèi)存中
'=====================================================================================
Private Sub CmdSelectFile_Click() ' 選擇要發(fā)送的文件
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 ' 關(guān)閉文件
Err:
End Sub
'=====================================================================================
' 文件數(shù)據(jù)發(fā)送
'=====================================================================================
Private Sub CmdSendFile_Click() '發(fā)送文件
On Error GoTo Err
If MSComm.PortOpen = True Then ' 如果串口打開了，則可以發(fā)送數(shù)據(jù)
If FileData = "" Then ' 判斷發(fā)送數(shù)據(jù)是否為空
MsgBox "發(fā)送的文件為空", 16, "串口調(diào)試助手" ' 發(fā)送數(shù)據(jù)為空則提示
Else
If ChkHexReceive.Value = 1 Then ' 如果按十六進(jìn)制接收時，按二進(jìn)制發(fā)送，否則按文本發(fā)送
MSComm.InputMode = comInputModeBinary ' 二進(jìn)制發(fā)送
Else
MSComm.InputMode = comInputModeText ' 文本發(fā)送
End If
MSComm.Output = Trim(FileData) ' 發(fā)送數(shù)據(jù)
ModeSend = True ' 設(shè)置文本發(fā)送方式
End If
Else
MsgBox "串口沒有打開，請打開串口", 48, "串口調(diào)試助手" ' 如果串口沒有被打開，提示打開串口
End If
Err:
End Sub
'====================================================================================
' 發(fā)送文本數(shù)據(jù)
'====================================================================================
Private Sub CmdSend_Click() ' 發(fā)送按鈕
On Error GoTo Err
If MSComm.PortOpen = True Then ' 如果串口打開了，則可以發(fā)送數(shù)據(jù)
If TxtSend.Text = "" Then ' 判斷發(fā)送數(shù)據(jù)是否為空
MsgBox "發(fā)送數(shù)據(jù)不能為空", 16, "串口調(diào)試助手" ' 發(fā)送數(shù)據(jù)為空則提示
Else
If ChkHexSend.Value = 1 Then ' 發(fā)送方式判斷
MSComm.InputMode = comInputModeBinary ' 二進(jìn)制發(fā)送
Call hexSend ' 發(fā)送十六進(jìn)制數(shù)據(jù)
Else ' 按十六進(jìn)制接收文本方式發(fā)送的數(shù)據(jù)時，文本也要按二進(jìn)制發(fā)送發(fā)送
If ChkHexReceive.Value = 1 Then
MSComm.InputMode = comInputModeBinary ' 二進(jìn)制發(fā)送
Else
MSComm.InputMode = comInputModeText ' 文本發(fā)送
End If
MSComm.Output = Trim(TxtSend.Text) ' 發(fā)送數(shù)據(jù)
ModeSend = False ' 設(shè)置文本發(fā)送方式
End If
End If
Else
MsgBox "串口沒有打開，請打開串口", 48, "串口調(diào)試助手" ' 如果串口沒有被打開，提示打開串口
End If
Err:
End Sub
'====================================================================================
' 通信觸發(fā)事件
'====================================================================================
Private Sub MSComm_OnComm() ' 設(shè)置oncomm事件，讀取片機(jī)內(nèi)存的值
On Error GoTo Err
Select Case MSComm.CommEvent ' 每接收1個數(shù)就觸發(fā)一次
Case comEvReceive
If ChkHexReceive.Value = 1 Then
Call hexReceive ' 十六進(jìn)制接收
Else
Call textReceive ' 文本接收
End If
Case comEvSend ' 每發(fā)送1個數(shù)就觸發(fā)一次
If ChkHexSend.Value = 1 Then
Else
Call textSend ' 文本發(fā)送
End If
Case Else
End Select
Err:
End Sub
'====================================================================================
' 文本接收
'====================================================================================
Private Sub textReceive()
On Error GoTo Err
InputSignal = MSComm.Input
ReceiveCount = ReceiveCount + LenB(StrConv(InputSignal, vbFromUnicode)) ' 計算總接收數(shù)據(jù)
If DisplaySwitch = False Then ' 顯示接收文本
TxtReceive.Text = TxtReceive.Text & InputSignal ' 單片機(jī)內(nèi)存的值用TextReceive顯示出
TxtReceive.SelStart = Len(TxtReceive.Text) ' 顯示光標(biāo)位置
End If
TxtRXCount.Text = "RX:" & ReceiveCount ' 接收字節(jié)數(shù)顯示
If ChkAutoClear.Value = 1 Then ' 自動清空判斷
If ReceiveCount >= 65535 Then
TxtReceive.Text = ""
End If
End If
Err:
End Sub
'====================================================================================
' 文本發(fā)送
'====================================================================================
Private Sub textSend()
On Error GoTo Err
If ModeSend = True Then
OutputSignal = FileData ' 發(fā)送文件
Else
OutputSignal = TxtSend.Text ' 發(fā)送文本
End If
SendCount = SendCount + LenB(StrConv(OutputSignal, vbFromUnicode)) ' 計算總發(fā)送數(shù)
TxtTXCount.Text = "TX:" & SendCount ' 發(fā)送字節(jié)數(shù)顯示
Err:
End Sub
'====================================================================================
' 十六進(jìn)制發(fā)送
'====================================================================================
Private Sub hexSend()
On Error Resume Next
Dim outputLen As Integer ' 發(fā)送數(shù)據(jù)長度
Dim outData As String ' 發(fā)送數(shù)據(jù)暫存
Dim SendArr() As Byte ' 發(fā)送數(shù)組
Dim TemporarySave As String ' 數(shù)據(jù)暫存
Dim dataCount As Integer ' 數(shù)據(jù)個數(shù)計數(shù)
Dim i As Integer ' 局部變量
outData = UCase(Replace(TxtSend.Text, Space(1), Space(0))) ' 先去掉空格，再轉(zhuǎn)換為大寫字母
outData = UCase(outData) ' 轉(zhuǎn)換成大寫
outputLen = Len(outData) ' 數(shù)據(jù)長度
For i = 0 To outputLen
TemporarySave = Mid(outData, i + 1, 1) ' 取一位數(shù)據(jù)
If (Asc(TemporarySave) >= 48 And Asc(TemporarySave) <= 57) Or (Asc(TemporarySave) >= 65 And Asc(TemporarySave) <= 70) Then
dataCount = dataCount + 1
Else
Exit For
Exit Sub
End If
Next
If dataCount Mod 2 <> 0 Then ' 判斷十六進(jìn)制數(shù)據(jù)是否為雙數(shù)
dataCount = dataCount - 1 ' 不是雙數(shù)，則減1
End If
outData = Left(outData, dataCount) ' 取出有效的十六進(jìn)制數(shù)據(jù)
ReDim SendArr(dataCount / 2 - 1) ' 重新定義數(shù)組長度
For i = 0 To dataCount / 2 - 1
SendArr(i) = Val("&H" + Mid(outData, i * 2 + 1, 2)) ' 取出數(shù)據(jù)轉(zhuǎn)換成十六進(jìn)制并放入數(shù)組中
Next
SendCount = SendCount + (dataCount / 2) ' 計算總發(fā)送數(shù)
TxtTXCount.Text = "TX:" & SendCount
MSComm.Output = SendArr ' 發(fā)送數(shù)據(jù)
End Sub
'====================================================================================
' 十六進(jìn)制數(shù)據(jù)接受
'====================================================================================
Private Sub hexReceive()
On Error GoTo Err
Dim ReceiveArr() As Byte ' 接收數(shù)據(jù)數(shù)組
Dim receiveData As String ' 數(shù)據(jù)暫存
Dim Counter As Integer ' 接收數(shù)據(jù)個數(shù)計數(shù)器
Dim i As Integer ' 循環(huán)變量
If (MSComm.InBufferCount > 0) Then
Counter = MSComm.InBufferCount ' 讀取接收數(shù)據(jù)個數(shù)
receiveData = "" ' 清緩沖
ReceiveArr = MSComm.Input ' 數(shù)據(jù)放入數(shù)組
For i = 0 To (Counter - 1) Step 1 ' 數(shù)據(jù)格式處理
If (ReceiveArr(i) < 16) Then
receiveData = receiveData & "0" + Hex(ReceiveArr(i)) & Space(1) ' 小于16，前面加0
Else
receiveData = receiveData & Hex(ReceiveArr(i)) & Space(1) ' 加空格顯示
End If
Next i
TxtReceive.Text = TxtReceive.Text + receiveData ' 顯示接收的十六進(jìn)制數(shù)據(jù)
TxtReceive.SelStart = Len(TxtReceive.Text) ' 顯示光標(biāo)位置
End If
ReceiveCount = ReceiveCount + Counter ' 接收計數(shù)
TxtRXCount.Text = "RX:" & ReceiveCount ' 接收字節(jié)數(shù)顯示
If ChkAutoClear.Value = 1 Then ' 自動清空判斷
If ReceiveCount >= 65535 Then
TxtReceive.Text = ""
End If
End If
Err:
End Sub
'=====================================================================================
' 串口開關(guān)
'=====================================================================================
Private Sub CmdSwitch_Click() ' 串口開關(guān)按鈕
On Error GoTo Err
If MSComm.PortOpen = True Then
ComSwitch = True
Else
ComSwitch = False
End If
If ComSwitch = False Then
OpenCom ' 打開串口
ComSwitch = True
Else
CloseCom ' 關(guān)閉串口
ComSwitch = False
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 ' 先判斷串口是否打開，如果打開則先關(guān)閉
MSComm.CommPort = Port ' 設(shè)定端口
MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 設(shè)置波特率，無校驗，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個字符到接收緩沖區(qū)引起觸發(fā)接收事件
MSComm.OutBufferCount = 0 ' 清空發(fā)送緩沖區(qū)
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" ' 串口沒打開時，提示串口關(guān)閉狀態(tài)
End If
Exit Sub
ErrorTrap: ' 錯誤處理
Select Case Err.Number
Case comPortAlreadyOpen ' 如果串口已經(jīng)打開，則提示
MsgBox "沒有發(fā)現(xiàn)此串口或被占用", 49, "串口調(diào)試助手"
CloseCom
Case Else
MsgBox "沒有發(fā)現(xiàn)此串口或被占用", 49, "串口調(diào)試助手"
CloseCom
End Select
Err.Clear
End Sub
'=====================================================================================
' 串口設(shè)置
'=====================================================================================
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 ' 先判斷串口是否打開，如果打開則先關(guān)閉
MSComm.CommPort = Port ' 設(shè)定端口
MSComm.Settings = BaudRate & "," & ParityBit & "," & DataBit & "," & StopBit ' 設(shè)置波特率，無校驗，8位數(shù)據(jù)位，1位停止位
MSComm.PortOpen = True ' 打開串口
If MSComm.PortOpen = True Then
CmdSwitch.Caption = "關(guān)閉串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口調(diào)試軟件\圖片\kai.jpg") ' 顯示串口已經(jīng)打開的圖標(biāo)
ImgSwitchOn.Visible = True
ImgSwitchOff.Visible = False
TxtStatus.Text = "STATUS：" & CboCom.Text & " OPEND，" & CboBaudrate.Text & "," & Left(CboParitybit.Text, 1) & "," & CboDatabit.Text & "," & CboStopbit.Text
Else
CmdSwitch.Caption = "打開串口"
ImgSwitchOn.Visible = False
ImgSwitchOff.Visible = True
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口調(diào)試軟件\圖片\guan.jpg") ' 顯示串口已經(jīng)關(guān)閉的圖標(biāo)
TxtStatus.Text = "STATUS：COM Port Cloced"
End If
Exit Sub
ErrorHint: ' 錯誤處理
Select Case Err.Number
Case comPortAlreadyOpen ' 如果串口已經(jīng)打開，則提示
MsgBox "沒有成功，請重試", vbExclamation, "串口調(diào)試助手"
CloseCom ' 調(diào)用關(guān)閉串口函數(shù)
Case Else
MsgBox "沒有成功，請重試", vbExclamation, "串口調(diào)試助手"
CloseCom ' 調(diào)用關(guān)閉串口函數(shù)
End Select
Err.Clear ' 清除 Err 對象的屬性
End Sub
'=====================================================================================
' 串口開關(guān)子程序
'=====================================================================================
Private Sub OpenCom() '打開串口
On Error GoTo Err
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關(guān)閉
Call Comm_reSet(Val(Mid(CboCom.Text, 4, 1)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text) ' 串口設(shè)置
If MSComm.PortOpen = True Then
TxtStatus.Text = "STATUS：" & CboCom.Text & " OPEND，" & CboBaudrate.Text & "," & Left(CboParitybit.Text, 1) & "," & CboDatabit.Text & "," & CboStopbit.Text
CmdSwitch.Caption = "關(guān)閉串口"
ImgSwitchOn.Visible = True ' 顯示串口已經(jīng)打開的圖標(biāo)
ImgSwitchOff.Visible = False
Else
TxtStatus.Text = "STATUS：COM Port Cloced" ' 串口狀態(tài)顯示
CmdSwitch.Caption = "打開串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口調(diào)試軟件\圖片\guan.jpg") ' 顯示串口已經(jīng)關(guān)閉的圖標(biāo)
ImgSwitchOff.Visible = True
ImgSwitchOn.Visible = False
End If
Err:
End Sub
Private Sub CloseCom() '關(guān)閉串口
On Error GoTo Err
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關(guān)閉
TxtStatus.Text = "STATUS：COM Port Cloced" ' 串口狀態(tài)顯示
CmdSwitch.Caption = "打開串口"
'ImgSwitch.Picture = LoadPicture("f:\我的VB\串口調(diào)試軟件\圖片\guan.jpg") ' 顯示串口已經(jīng)關(guān)閉的圖標(biāo)
ImgSwitchOn.Visible = False
ImgSwitchOff.Visible = True
Err:
End Sub
'=====================================================================================
' 顯示時間
'=====================================================================================
Private Sub TmrNowTime_Timer()
LblNewDate.Caption = Date ' 顯示時間
LblNowTime.Caption = Time ' 顯示系統(tǒng)時間
End Sub
'=====================================================================================
' 程序退出
'=====================================================================================
Private Sub CmdQuit_Click() ' 退出程序
If MSComm.PortOpen = True Then MSComm.PortOpen = False ' 先判斷串口是否打開，如果打開則先關(guān)閉
Unload Me ' 卸載窗體，并退出程序
End
End Sub
'=====================================================================================
' 幫助信息
'=====================================================================================
Private Sub CmdHelp_Click() ' 載入幫助信息窗口
FrmHelp.Show
End Sub
'--------------- 程序結(jié)束 ------------------

復(fù)制代碼

欧美极品高清xxxxhd,国产日产欧美最新,无码AV国产东京热AV无码,国产精品人与动性XXX,国产传媒亚洲综合一区二区,四库影院永久国产精品,毛片免费免费高清视频,福利所导航夜趣136