vb源码串口通讯程序.docx
- 文档编号:3902717
- 上传时间:2022-11-26
- 格式:DOCX
- 页数:19
- 大小:18.35KB
vb源码串口通讯程序.docx
《vb源码串口通讯程序.docx》由会员分享,可在线阅读,更多相关《vb源码串口通讯程序.docx(19页珍藏版)》请在冰豆网上搜索。
vb源码串口通讯程序
OptionExplicit
PrivateText1textAsString
PrivateRTUCRCAsString
'串口选择
PrivateSubCombo1_Click()
MSComm1.CommPort=Combo1.ListIndex+1
EndSub
'数据位改变
PrivateSubCombo2_Click()
Callsetting
EndSub
'波特率改变
PrivateSubCombo3_Click()
Callsetting
EndSub
'奇偶校验改变
PrivateSubCombo4_Click()
Callsetting
EndSub
'停止位改变
PrivateSubCombo5_Click()
Callsetting
EndSub
PrivateSubsetting()
MSComm1.Settings=CStr(Combo3.Text)&","&CStr(Combo4.Text)&","&CStr(Combo2.Text)_
&","&CStr(Combo5.Text)
EndSub
'打开关闭串口
PrivateSubCommand1_Click()
OnErrorResumeNext
IfMSComm1.PortOpen=FalseThen
MSComm1.PortOpen=True
Else
MSComm1.PortOpen=False
EndIf
IfMSComm1.PortOpenThen'打开关闭按钮显示文字及combo1使能
Command1.Caption="关闭串口"
Combo1.Enabled=False
Else
Command1.Caption="打开串口"
Combo1.Enabled=True
EndIf
IfErrThen'打开串口失败,则显示出错信息
MsgBoxError$,48,"错误信息"
ExitSub
EndIf
EndSub
PrivateSubCommand10_Click()
EndSub
'10转16进制
PrivateSubCommand2_Click()
OnErrorResumeNext
Text4.Text=Hex(Text3.Text)
IfErrThen'\'则显示出错信息
MsgBoxError$,48,"错误信息"
ExitSub
EndIf
EndSub
'16转10进制
PrivateSubCommand3_Click()‘16进制显示按钮
DimaAsLong
a=Val("&H"&CStr(Text4.Text))
Text3.Text=a
EndSub
'手动串口发送
PrivateSubCommand4_Click()‘手动发送按钮
IfMSComm1.PortOpen=FalseThen
MsgBox"请先打开串口",,"错误信息"
ExitSub
EndIf
Callsentsub
EndSub
'清除接收窗
PrivateSubCommand5_Click()‘清除按钮
Text2.Text=""
EndSub
PrivateSubCommand6_Click()‘关闭按钮
UnloadMe
EndSub
'窗口加载
PrivateSubForm_Load()
Dimd%
Ford=1To16
Combo1.AddItem("COM"&CStr(d))
Next
Combo1.ListIndex=0
Combo2.AddItem"6"
Combo2.AddItem"7"
Combo2.AddItem"8"
Combo2.ListIndex=2
Combo3.AddItem"110"
Combo3.AddItem"330"
Combo3.AddItem"1200"
Combo3.AddItem"2400"
Combo3.AddItem"4800"
Combo3.AddItem"9600"
Combo3.AddItem"19200"
Combo3.AddItem"38400"
Combo3.AddItem"56000"
Combo3.AddItem"57600"
Combo3.AddItem"115200"
Combo3.ListIndex=5‘默认
Combo4.AddItem"n"
Combo4.AddItem"o"
Combo4.AddItem"e"
Combo4.ListIndex=0
Combo5.AddItem"1"
Combo5.AddItem"2"
Combo5.ListIndex=0
Ford=0To254
Combo6.AddItemd
Next
Combo6.ListIndex=1
Text1.Text="010601001770"
Text2.Text=""
Text3.Text=""
Text4.Text=""
Text5.Text="1000"
Text6.Text="06"
Text7.Text="0"
Text8.Text="1"
Option1.Value=True
Option3.Value=True
IfMSComm1.PortOpen=FalseThen
Command1.Caption="打开串口"
Else
Command1.Caption="关闭串口"
EndIf
EndSub
'串口接收程序
PrivateSubMSComm1_OnComm()
DimHexchrAsString,hexstringAsString,iAsInteger,jAsInteger,hexdispAsString
IfOption8.ValueThen
hexstring=MSComm1.Input'十六进制显示
i=Len(hexstring)
Forj=1Toi
Hexchr=Mid(hexstring,j,1)
IfHex(Asc(Hexchr))<16Then
Text2.Text=Text2.Text&"0"&Hex(Asc(Hexchr))&""
Else
Text2.Text=Text2.Text&Hex(Asc(Hexchr))&""
EndIf
Nextj
Text2.Text=Text2.Text&CStr(Chr(13))&CStr(Chr(10))
Else
Text2.Text=Text2.Text&MSComm1.Input&CStr(Chr(13))&CStr(Chr(10))'ASCII码显示
EndIf
EndSub
'手动发送选择
PrivateSubOption1_Click()
IfOption1.Value=TrueThen
Timer1.Enabled=False
Command4.Enabled=True
Else
Timer1.Enabled=True
Command4.Enabled=False
EndIf
EndSub
'DeltaASCII发送协议
PrivateSubOption10_Click()
Combo6.Enabled=True
Text6.Enabled=True
Text7.Enabled=True
Text8.Enabled=True
Label10.Enabled=True
Label11.Enabled=True
Label12.Enabled=True
Label13.Enabled=True
Option6.Enabled=False
Combo2.ListIndex=1
Combo5.ListIndex=1
Text1.Enabled=False
Label14.Enabled=False
EndSub
PrivateSubOption11_Click()
EndSub
PrivateSubOption12_Click()
EndSub
'自动发送选择
PrivateSubOption2_Click()
IfOption2.Value=TrueThen
Timer1.Enabled=True
Command4.Enabled=False
Else
Timer1.Enabled=False
Command4.Enabled=True
EndIf
EndSub
PrivateSubOption3_Click()'Non选项
Combo6.Enabled=False
Text6.Enabled=False
Text7.Enabled=False
Text8.Enabled=False
Label10.Enabled=False
Label11.Enabled=False
Label12.Enabled=False
Label13.Enabled=False
Combo2.ListIndex=2
Combo5.ListIndex=0
Text1.Enabled=True
Label14.Enabled=True
EndSub
PrivateSubOption4_Click()'ASCII选项
Combo6.Enabled=True
Text6.Enabled=True
Text7.Enabled=True
Text8.Enabled=True
Label10.Enabled=True
Label11.Enabled=True
Label12.Enabled=True
Label13.Enabled=True
Option6.Enabled=False
Combo2.ListIndex=1
Combo5.ListIndex=1
Text1.Enabled=False
Label14.Enabled=False
EndSub
PrivateSubOption5_Click()'RTU选项
Combo6.Enabled=True
Text6.Enabled=True
Text7.Enabled=True
Text8.Enabled=True
Label10.Enabled=True
Label11.Enabled=True
Label12.Enabled=True
Label13.Enabled=True
Option6.Enabled=False
Combo2.ListIndex=2
Combo5.ListIndex=1
Text1.Enabled=False
Label14.Enabled=False
EndSub
'发送时间间隔调整输入
PrivateSubText5_Change()
DimnumberAsString
DimnumAsInteger
DimnumcycAsInteger
num=Len(Text5.Text)
Fornumcyc=1Tonum
number=Mid(Text5.Text,numcyc,1)
SelectCaseInStr("0123456789",number)
Case0
MsgBox"输入时间间隔错误,请重新输入",,"错误信息"
ExitSub
EndSelect
Next
Timer1.Interval=Text5.Text
EndSub
'自动发送定时器
PrivateSubTimer1_Timer()
IfMSComm1.PortOpenThen
Callsentsub
EndIf
EndSub
'状态刷新定时器
PrivateSubTimer2_Timer()
StatusBar1.Panels
(1).Text="串口选择:
"&CStr(Combo1.Text)
StatusBar1.Panels
(2).Text="串口设置:
"&CStr(MSComm1.Settings)
StatusBar1.Panels(3).Text="串口状态:
"&CStr(MSComm1.PortOpen)
EndSub
'串口发送子程序
PrivateSubsentsub()
Dimoptioncase%
IfOption3.ValueThenoptioncase=1
IfOption4.ValueThenoptioncase=2
IfOption5.ValueThenoptioncase=3
IfOption10.ValueThenoptioncase=4
SelectCaseoptioncase
Case1‘无校验
IfOption6.ValueThen
Text1text=Text1.Text
CallHexsent‘16进制发送
Else
Text1text=Text1.Text
CallASCIIsent‘ascii发送
EndIf
Case2
Callincorporate'将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
CallASCIIcheck
CallASCIIsent‘ASCIIcheck校验
Case3
Callincorporate'将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
CallRTUcheck‘校验
CallHexsent
Case4
Callincorporate1'将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
CalldeltaASCII‘校验
CallASCIIsent
EndSelect
EndSub
'十六进制发送
PrivateSubHexsent()
Dimhexchrlen%,HexchrAsString,hexcyc%,hexmidAsByte,hexmiddleAsString
Dimhexchrgroup()AsByte,iAsInteger
Text1text=Text1.Text
hexchrlen=Len(Text1text)
Forhexcyc=1Tohexchrlen'检查Text1文本框内数值是否合适
Hexchr=Mid(Text1text,hexcyc,1)
IfInStr("0123456789ABCDEFabcdef",Hexchr)=0Then
‘返回某字符串在另一字符串中第一次出现的位置。
没有找到返回0
MsgBox"无效的数值,请重新输入",,"错误信息"
ExitSub
EndIf
Nexthexcyc
ReDimhexchrgroup(1Tohexchrlen\2)AsByte
Forhexcyc=1TohexchrlenStep2'将文本框内数值分成两个、两个
i=i+1
Hexchr=Mid(Text1text,hexcyc,2)
hexmid=Val("&H"&CStr(Hexchr))
hexchrgroup(i)=hexmid
'MSComm1.Output=CStr(hexmid)
Next
MSComm1.Output=hexchrgroup
EndSub
'ASC码发送
PrivateSubASCIIsent()
MSComm1.Output=Text1text
EndSub
'ASC校验,此段程序计算出LRC校验值,并加上字头和字尾
PrivateSubASCIIcheck()
Dima%,b%,chrnum%,LrcbyteAsString
Dimchecksum%,char%,AscLrc%,Lrc%
chrnum=Len(Text1text)
Fora=1TochrnumStep2
char=Val("&H"&CStr(Mid(Text1text,a,2)))'两个两个的取字符
checksum=checksum+char'全部加起来
Next
AscLrc=checksumMod&H100'取255的余数
Lrc=(&HFF-AscLrc)+1'取二次补
IfLrc<16Then'此段程序是判断Hex(lrc)是否是一位数,
Lrcbyte="0"+CStr(Hex(Lrc))'如果是的话,前面加0;否则不加零
Else
Lrcbyte=CStr(Hex(Lrc))
EndIf
Text1text=CStr(Chr(58))&CStr(Text1text)&Lrcbyte&CStr(Chr(13))&CStr(Chr(10))
EndSub
'DeltaASCII校验,此段程序计算出LRC校验值,并加上字头和字尾
PrivateSubdeltaASCII()
Dima%,b%,chrnum%,LrcbyteAsString
Dimchecksum%,char%,Lrc%
chrnum=Len(Text1text)
Fora=1Tochrnum
char=Asc(Mid(Text1text,a,1))'两个两个的取字符
checksum=checksum+char'全部加起来
Next
Lrc=(checksum+&H3)Mod&H100'取255的余数
IfLrc<16Then'此段程序是判断Hex(lrc)是否是一位数,
Lrcbyte="0"+CStr(Hex(Lrc))'如果是的话,前面加0;否则不加零
Else
Lrcbyte=CStr(Hex(Lrc))
EndIf
Text1text=CStr(Chr
(2))&CStr(Text1text)&CStr(Chr(3))&Lrcbyte
EndSub
'RTU校验
PrivateSubRTUcheck()
DimCRC()AsByte
Dimd(5)AsByte
Dimstring1AsString
DimjAsInteger,chrlengthAsInteger,tempAsString
Text1text=Text1.Text
string1=Text1text
chrlength=Len(string1)
Forj=0Tochrlength/2-1
temp=Mid(string1,j*2+1,2)
d(j)=Val("&H"&temp)
Next
RTUCRC=CRC16(d)'调用CRC16计算函数,CRC(0)为高位,CRC
(1)为低位
Text1text=Text1text&RTUCRC
EndSub
PrivateSubincorporate()'将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
DimwholecharAsString,wc%,wcyc%,wcharAsString
DimSIDAsString,CmdAsString,InfoAddAsString,dataAsString
DimSIDnum%,Cmdnum%,InfoAddNum%,Datanum%
OnErrorResumeNext
wholechar=CStr(Combo6.Text)&CStr(Text6.Text)&CStr(Text7.Text)&CStr(Text8.Text)
wc=Len(wholechar)
Forwcyc=1Towc
wchar=Mid(wholechar,wcyc,1)
IfInStr("0123456789",wchar)=0Then
MsgBox"输入错误,请重新输入",,"错误提示"
ExitSub
EndIf
Next
SIDnum=Len(CStr(Hex(Combo6.Text)))
SelectCaseSIDnum
Case0
ExitSub
Case1
SID="0"&CStr(Hex(Combo6.Text))
Case2
SID=CStr(Hex(Combo6.Text))
EndSelect
Cmdnum=Len(CStr(Hex(Text6.Text)))
SelectCaseCmdnum
Case0
ExitSub
Case1
Cmd="0"&CStr(Hex(Text6.Text))
Case1
Cmd=CStr(Hex(Text6.Text))
EndSelect
InfoAddNum=Len(CStr(Hex(Text7.Text)))
SelectCaseInfoAddNum
Case0
ExitSub
Case1
InfoAdd="000"&CStr(Hex(Text7.Text))
Cas
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- vb 源码 串口 通讯 程序
![提示](https://static.bdocx.com/images/bang_tan.gif)