vb源码串口通讯程序

OptionExplicitPrivateText1textAsStringPrivateRTUCRCAsString'串口选择PrivateSubCombo1_Click()MSComm1.CommPort=Combo1.ListIndex+1EndSub'数据位改变PrivateSubCombo2_Click()CallsettingEndSub'波特率改变PrivateSubCombo3_Click()CallsettingEndSub'奇偶校验改变PrivateSubCombo4_Click()CallsettingEndSub'停止位改变PrivateSubCombo5_Click()CallsettingEndSubPrivateSubsetting()MSComm1.Settings=CStr(Combo3.Text)&,&CStr(Combo4.Text)&,&CStr(Combo2.Text)_&,&CStr(Combo5.Text)EndSub'打开关闭串口PrivateSubCommand1_Click()OnErrorResumeNextIfMSComm1.PortOpen=FalseThenMSComm1.PortOpen=TrueElseMSComm1.PortOpen=FalseEndIfIfMSComm1.PortOpenThen'打开关闭按钮显示文字及combo1使能Command1.Caption=关闭串口Combo1.Enabled=FalseElseCommand1.Caption=打开串口Combo1.Enabled=TrueEndIfIfErrThen'打开串口失败，则显示出错信息MsgBoxError$,48,错误信息ExitSubEndIfEndSubPrivateSubCommand10_Click()EndSub'10转16进制PrivateSubCommand2_Click()OnErrorResumeNextText4.Text=Hex(Text3.Text)IfErrThen'\'则显示出错信息MsgBoxError$,48,错误信息ExitSubEndIfEndSub'16转10进制PrivateSubCommand3_Click()‘16进制显示按钮DimaAsLonga=Val(&H&CStr(Text4.Text))Text3.Text=aEndSub'手动串口发送PrivateSubCommand4_Click()‘手动发送按钮IfMSComm1.PortOpen=FalseThenMsgBox请先打开串口,,错误信息ExitSubEndIfCallsentsubEndSub'清除接收窗PrivateSubCommand5_Click()‘清除按钮Text2.Text=EndSubPrivateSubCommand6_Click()‘关闭按钮UnloadMeEndSub'窗口加载PrivateSubForm_Load()Dimd%Ford=1To16Combo1.AddItem(COM&CStr(d))NextCombo1.ListIndex=0Combo2.AddItem6Combo2.AddItem7Combo2.AddItem8Combo2.ListIndex=2Combo3.AddItem110Combo3.AddItem330Combo3.AddItem1200Combo3.AddItem2400Combo3.AddItem4800Combo3.AddItem9600Combo3.AddItem19200Combo3.AddItem38400Combo3.AddItem56000Combo3.AddItem57600Combo3.AddItem115200Combo3.ListIndex=5‘默认Combo4.AddItemnCombo4.AddItemoCombo4.AddItemeCombo4.ListIndex=0Combo5.AddItem1Combo5.AddItem2Combo5.ListIndex=0Ford=0To254Combo6.AddItemdNextCombo6.ListIndex=1Text1.Text=010601001770Text2.Text=Text3.Text=Text4.Text=Text5.Text=1000Text6.Text=06Text7.Text=0Text8.Text=1Option1.Value=TrueOption3.Value=TrueIfMSComm1.PortOpen=FalseThenCommand1.Caption=打开串口ElseCommand1.Caption=关闭串口EndIfEndSub'串口接收程序PrivateSubMSComm1_OnComm()DimHexchrAsString,hexstringAsString,iAsInteger,jAsInteger,hexdispAsStringIfOption8.ValueThenhexstring=MSComm1.Input'十六进制显示i=Len(hexstring)Forj=1ToiHexchr=Mid(hexstring,j,1)IfHex(Asc(Hexchr))16ThenText2.Text=Text2.Text&0&Hex(Asc(Hexchr))&ElseText2.Text=Text2.Text&Hex(Asc(Hexchr))&EndIfNextjText2.Text=Text2.Text&CStr(Chr(13))&CStr(Chr(10))ElseText2.Text=Text2.Text&MSComm1.Input&CStr(Chr(13))&CStr(Chr(10))'ASCII码显示EndIfEndSub'手动发送选择PrivateSubOption1_Click()IfOption1.Value=TrueThenTimer1.Enabled=FalseCommand4.Enabled=TrueElseTimer1.Enabled=TrueCommand4.Enabled=FalseEndIfEndSub'DeltaASCII发送协议PrivateSubOption10_Click()Combo6.Enabled=TrueText6.Enabled=TrueText7.Enabled=TrueText8.Enabled=TrueLabel10.Enabled=TrueLabel11.Enabled=TrueLabel12.Enabled=TrueLabel13.Enabled=TrueOption6.Enabled=FalseCombo2.ListIndex=1Combo5.ListIndex=1Text1.Enabled=FalseLabel14.Enabled=FalseEndSubPrivateSubOption11_Click()EndSubPrivateSubOption12_Click()EndSub'自动发送选择PrivateSubOption2_Click()IfOption2.Value=TrueThenTimer1.Enabled=TrueCommand4.Enabled=FalseElseTimer1.Enabled=FalseCommand4.Enabled=TrueEndIfEndSubPrivateSubOption3_Click()'Non选项Combo6.Enabled=FalseText6.Enabled=FalseText7.Enabled=FalseText8.Enabled=FalseLabel10.Enabled=FalseLabel11.Enabled=FalseLabel12.Enabled=FalseLabel13.Enabled=FalseCombo2.ListIndex=2Combo5.ListIndex=0Text1.Enabled=TrueLabel14.Enabled=TrueEndSubPrivateSubOption4_Click()'ASCII选项Combo6.Enabled=TrueText6.Enabled=TrueText7.Enabled=TrueText8.Enabled=TrueLabel10.Enabled=TrueLabel11.Enabled=TrueLabel12.Enabled=TrueLabel13.Enabled=TrueOption6.Enabled=FalseCombo2.ListIndex=1Combo5.ListIndex=1Text1.Enabled=FalseLabel14.Enabled=FalseEndSubPrivateSubOption5_Click()'RTU选项Combo6.Enabled=TrueText6.Enabled=TrueText7.Enabled=TrueText8.Enabled=TrueLabel10.Enabled=TrueLabel11.Enabled=TrueLabel12.Enabled=TrueLabel13.Enabled=TrueOption6.Enabled=FalseCombo2.ListIndex=2Combo5.ListIndex=1Text1.Enabled=FalseLabel14.Enabled=FalseEndSub'发送时间间隔调整输入PrivateSubText5_Change()DimnumberAsStringDimnumAsIntegerDimnumcycAsIntegernum=Len(Text5.Text)Fornumcyc=1Tonumnumber=Mid(Text5.Text,numcyc,1)SelectCaseInStr(0123456789,number)Case0MsgBox输入时间间隔错误，请重新输入,,错误信息ExitSubEndSelectNextTimer1.Interval=Text5.TextEndSub'自动发送定时器PrivateSubTimer1_Timer()IfMSComm1.PortOpenThenCallsentsubEndIfEndSub'状态刷新定时器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=1IfOption4.ValueThenoptioncase=2IfOption5.ValueThenoptioncase=3IfOption10.ValueThenoptioncase=4SelectCaseoptioncaseCase1‘无校验IfOption6.ValueThenText1text=Text1.TextCallHexsent‘16进制发送ElseText1text=Text1.TextCallASCIIsent‘ascii发送EndIfCase2Callincorporate'将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串CallASCIIcheckCallASCIIsent‘ASCIIcheck校验Case3Callincorporate'将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串CallRTUcheck‘校验CallHexsentCase4Callinc