经典的串口调试工具源代码二.docx
《经典的串口调试工具源代码二.docx》由会员分享，可在线阅读，更多相关《经典的串口调试工具源代码二.docx（17页珍藏版）》请在冰豆网上搜索。
经典的串口调试工具源代码二
经典的串口调试工具源代码
（二）
PrivateSubcmdswitch_Click（）
OnErrorGoToErr
IfMSComm.PortOpen=TrueThen
ComSwitch=True
Else
ComSwitch=False
EndIf
IfComSwitch=FalseThen
StatusBar1.Panels
（1）.Text="Connected"
mnuconnect.Caption="Dis&connect"
OpenCom '打开串口
ComSwitch=True
Else
CloseCom '关闭串口
ComSwitch=False
StatusBar1.Panels
（1）.Text="Disconnected"
mnuconnect.Caption="&Connect"
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"
EndIf
EndIf
Err:
EndSub
PrivateSubForm_Load（）
OnErrorGoToErr
lblWEB.FontUnderline=True 'WEB上加下划线
lblWEB.ForeColor=vbBlue '蓝色显示WEB
txtsend.Text="" '载入发送信息
IfMSComm.PortOpen=TrueThenMSComm.PortOpen=False '先判断串口是否打开，如果打开则先关闭
'初始化串口
CallComm_initial（Val（Mid（cbocom.Text,4,1））,cbobaudrate.Text,Left（cboparitybit.Text,1）,cbodatabit.Text,cbostopbit.Text）
'数据位载入
cbodatabit.AddItem"8"
cbodatabit.AddItem"7"
cbodatabit.AddItem"6"
'停止位载入
cbostopbit.AddItem"1"
cbostopbit.AddItem"1.5"
cbostopbit.AddItem"2"
Err:
EndSub
PrivateSubhexReceive（）
OnErrorGoToErr
DimReceiveArr（）AsByte '接收数据数组
DimreceiveDataAsString '数据暂存
DimCounterAsInteger '接收数据个数计数器
DimiAsInteger '循环变量
If（MSComm.InBufferCount>0）Then
Counter=MSComm.InBufferCount '读取接收数据个数
receiveData="" '清缓冲
ReceiveArr=MSComm.Input '数据放入数组
Fori=0To（Counter-1）Step1 '数据格式处理
If（ReceiveArr（i）<16）Then
receiveData=receiveData&"0"+Hex（ReceiveArr（i））&Space
（1） '小于16，前面加0
Else
receiveData=receiveData&Hex（ReceiveArr（i））&Space
（1） '加空格显示
EndIf
Nexti
TxtReceive.Text=TxtReceive.Text+receiveData '显示接收的十六进制数据
TxtReceive.SelStart=Len（TxtReceive.Text） '显示光标位置
EndIf
ReceiveCount=ReceiveCount+Counter '接收计数
txtRXcount.Text="RX:
"&ReceiveCount '接收字节数显示
Ifchkautoclear.Value=1Then '自动清空判断
IfReceiveCount>=65535Then
TxtReceive.Text=""
EndIf
EndIf
Err:
EndSub
PrivateSubhexSend（）
OnErrorResumeNext
DimoutputLenAsInteger '发送数据长度
DimoutDataAsString '发送数据暂存
DimSendArr（）AsByte '发送数组
DimTemporarySaveAsString '数据暂存
DimdataCountAsInteger '数据个数计数
DimiAsInteger '局部变量
outData=UCase（Replace（txtsend.Text,Space
（1）,Space（0））） '先去掉空格，再转换为大写字母
outData=UCase（outData） '转换成大写
outputLen=Len（outData） '数据长度
Fori=0TooutputLen
TemporarySave=Mid（outData,i+1,1） '取一位数据
If（Asc（TemporarySave）>=48AndAsc（TemporarySave）<=57）Or（Asc（TemporarySave）>=65AndAsc（TemporarySave）<=70）Then
dataCount=dataCount+1
Else
ExitFor
ExitSub
EndIf
Next
IfdataCountMod2<>0Then '判断十六进制数据是否为双数
dataCount=dataCount-1 '不是双数，则减1
EndIf
outData=Left（outData,dataCount） '取出有效的十六进制数据
ReDimSendArr（dataCount/2-1） '重新定义数组长度
Fori=0TodataCount/2-1
SendArr（i）=Val（"&H"+Mid（outData,i*2+1,2）） '取出数据转换成十六进制并放入数组中
Next
SendCount=SendCount+（dataCount/2） '计算总发送数
txtTXcount.Text="TX:
"&SendCount
MSComm.Output=SendArr '发送数据
EndSub
PrivateSubOpenCom（）'打开串口
OnErrorGoToErr
IfMSComm.PortOpen=TrueThenMSComm.PortOpen=False '先判断串口是否打开，如果打开则先关闭
CallComm_reSet（Val（Mid（cbocom.Text,4,1））,cbobaudrate.Text,Left（cboparitybit.Text,1）,cbodatabit.Text,cbostopbit.Text） '串口设置
IfMSComm.PortOpen=TrueThen
txtstatus.Text="STATUS：
"&cbocom.Text&"OPEND，"&cbobaudrate.Text&","&Left（cboparitybit.Text,1）&","&cbodatabit.Text&","&cbostopbit.Text
cmdswitch.Caption="关闭串口"
mnuconnect.Caption="disconnect"
'ImgSwitch.Picture=LoadPicture（"f:
\我的VB\串口调试软件\图片\kai.jpg"） '显示串口已经打开的图标
ImgSwitchon.Visible=True
ImgSwitchoff.Visible=False
Else
txtstatus.Text="STATUS：
COMPortCloced" '串口状态显示
cmdswitch.Caption="打开串口"
mnuconnect.Caption="connect"
'ImgSwitch.Picture=LoadPicture（"f:
\我的VB\串口调试软件\图片\guan.jpg"） '显示串口已经关闭的图标
ImgSwitchoff.Visible=True
ImgSwitchon.Visible=False
EndIf
Err:
EndSub
PrivateSubtextReceive（）
OnErrorGoToErr
InputSignal=MSComm.Input
ReceiveCount=ReceiveCount+LenB（StrConv（InputSignal,vbFromUnicode）） '计算总接收数据
IfDisplaySwitch=FalseThen '显示接收文本
TxtReceive.Text=TxtReceive.Text&InputSignal '单片机内存的值用TextReceive显示出
TxtReceive.SelStart=Len（TxtReceive.Text） '显示光标位置
EndIf
txtRXcount.Text="RX:
"&ReceiveCount '接收字节数显示
Ifchkautoclear.Value=1Then '自动清空判断
IfReceiveCount>=65535Then
TxtReceive.Text=""
EndIf
EndIf
Err:
EndSub
PrivateSubtextSend（）
OnErrorGoToErr
IfModeSend=TrueThen
OutputSignal=FileData '发送文件
Else
OutputSignal=txtsend.Text '发送文本
EndIf
SendCount=SendCount+LenB（StrConv（OutputSignal,vbFromUnicode）） '计算总发送数
txtTXcount.Text="TX:
"&SendCount '发送字节数显示
Err:
EndSub
PrivateSubImage1_Click（）
EndSub
PrivateSubmnuautosend_Click（）
OnErrorGoToErr
'IfTmrAutoSend.Enabled=TrueThen '如果有效则，自动发送
IfMSComm.PortOpen=TrueThen '串口状态判断
ChkAutoSend.Value=1
TmrAutoSend.Interval=Val（TxtAutoSendTime） '设置自动发送时间
mnuautosend.Caption="取消自动发送"
TmrAutoSend.Enabled=True '打开自动发送定时器
Else
mnuautosend.Caption="自动发送"
ChkAutoSend.Value=0 '串口没有打开去掉自动发送
MsgBox"串口没有打开，请打开串口",48,"串口调试助手" '如果串口没有被打开，提示打开串口
EndIf
'ElseIfTmrAutoSend.Enabled=FalseThen '如果无效，不发送
' mnuautosend.Caption="autosend"
' TmrAutoSend.Enabled=False '关闭自动发送定时器
'EndIf
Err:
EndSub
PrivateSubmnucom_Click（IndexAsInteger）
DimiAsInteger
DimOldPortAsLong
OnErrorResumeNext
WithMSComm
OldPort=.CommPort
IfMSComm.PortOpenThen
.PortOpen=False
.CommPort=Index
.PortOpen=True
IfErr.Number<>0Then 'Thisshouldnothappen...
MsgBox"Com"&Index&"isnotavailable."&_
vbCrLf&Err.Description
Err.Clear
.CommPort=OldPort
Else
Fori=1To4
mnucom（i）.Checked=False
Nexti
mnucom（Index）.Checked=True
EndIf
Else
.CommPort=Index
Fori=1To4
mnucom（i）.Checked=F
升级会员 