VB编程高手请当心 重赏MODBUS通讯VB程式高手 (vb编程入门教程)

Modbus通讯协定&VB测试程序协定内容:

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,"失误消息"ExitSubEndIfEndSub'10转16进制PrivateSubCommand2_Click(IndexAsInteger)OnErrorResumeNextText4.Text=Hex(Text3.Text)IfErrThen''则显示出错消息MsgBoxError$,48,"失误消息"ExitSubEndIfEndSub'16转10进制PrivateSubCommand3_Click()DimaAsLonga=Val("&H"&CStr(Text4.Text))Text3.Text=aEndSub'手动串口发送PrivateSubCommand4_Click()IfMSComm1.PortOpen=FalseThenMsgBox"请先关上串口",,"失误消息"ExitSubEndIfCallsentsubEndSub'肃清接纳窗PrivateSubCommand5_Click()Text2.Text=""EndSubPrivateSubCommand6_Click()UnloadMeEndSubPrivateSubCommand7_Click()OnErrorResumeNextDimSTPAsStringSTP=CStr(Chr(2))&"010001"&CStr(Chr(3))&"25"MSComm1.Settings="9600,N,7,2"MSComm1.PortOpen=TrueMSComm1.Output=STPMSComm1.PortOpen=FalseIfErrThen'关上串口失败，则显示出错消息MsgBoxError$,48,"失误消息"ExitSubEndIfEndSubPrivateSubCommand8_Click()OnErrorResumeNextDimFWDAsStringFWD=CStr(Chr(2))&"010101"&CStr(Chr(3))&"26"MSComm1.Settings="9600,N,7,2"MSComm1.PortOpen=TrueMSComm1.Output=FWDMSComm1.PortOpen=FalseIfErrThen'关上串口失败，则显示出错消息MsgBoxError$,48,"失误消息"ExitSubEndIfEndSubPrivateSubCommand9_Click()OnErrorResumeNextDimREVAsStringREV=CStr(Chr(2))&"010201"&CStr(Chr(3))&"27"MSComm1.Settings="9600,N,7,2"MSComm1.PortOpen=TrueMSComm1.Output=REVMSComm1.PortOpen=FalseIfErrThen'关上串口失败，则显示出错消息MsgBoxError$,48,"失误消息"ExitSubEndIfEndSub'窗口加载PrivateSubForm_Load()Dimd%Ford=1To16Combo1.AddItem("COM"&CStr(d))NextCombo1.ListIndex=0Combo2.AddItem"6"Combo2.AddItem"7"Combo2.AddItem"8"Combo2.ListIndex=2Combo3.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=5Combo4.AddItem"n"Combo4.AddItem"o"Combo4.AddItem"e"Combo4.ListIndex=0Combo5.AddItem"1"Combo5.AddItem"2"Combo5.ListIndex=0Ford=0To254Combo6.AddItemdNextCombo6.ListIndex=1Text1.Text="010601001770"Text2.Text=""Text3.Text=""Text4.Text=""Text5.Text="1000"Text6.Text="06"Text7.Text="0"Text8.Text="1"Option1.value=TrueOption3.value=TrueOption7.value=TrueOption9.value=TrueIfMSComm1.PortOpen=FalseThenCommand1.Caption="关上串口"ElseCommand1.Caption="封锁串口"EndIfEndSub'串口接纳程序PrivateSubMSComm1_OnComm()DimHexｃｈｒAsString,hexstringAsString,iAsInteger,jAsInteger,hexdispAsStringIfOption8.valueThenhexstring=MSComm1.Input'十六进制显示i=Len(hexstring)Forj=1ToiHexｃｈｒ=ｍｉｄ（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=FalseOption7.Enabled=FalseOption11.value=TrueCombo2.ListIndex=1Combo5.ListIndex=1Text1.Enabled=FalseLabel14.Enabled=FalseFrame7.Visible=TrueEndSub

'智能发送选用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=FalseOption6.Enabled=TrueOption7.Enabled=TrueCombo2.ListIndex=2Combo5.ListIndex=0Text1.Enabled=TrueLabel14.Enabled=TrueFrame7.Visible=FalseEndSubPrivateSubOption4_Click()'ASCII选项Combo6.Enabled=TrueText6.Enabled=TrueText7.Enabled=TrueText8.Enabled=TrueLabel10.Enabled=TrueLabel11.Enabled=TrueLabel12.Enabled=TrueLabel13.Enabled=TrueOption6.Enabled=FalseOption7.Enabled=FalseCombo2.ListIndex=1Combo5.ListIndex=1Text1.Enabled=FalseLabel14.Enabled=FalseFrame7.Visible=FalseEndSubPrivateSubOption5_Click()'RTU选项Combo6.Enabled=TrueText6.Enabled=TrueText7.Enabled=TrueText8.Enabled=TrueLabel10.Enabled=TrueLabel11.Enabled=TrueLabel12.Enabled=TrueLabel13.Enabled=TrueOption6.Enabled=FalseOption7.Enabled=FalseCombo2.ListIndex=2Combo5.ListIndex=1Text1.Enabled=FalseLabel14.Enabled=FalseFrame7.Visible=FalseEndSub'发送时时期隔调整输入PrivateSubText5_Change()DimnumberAsStringDimnumAsIntegerDimnumcycAsIntegernum=Len(Text5.Text)Fornumcyc=1Tonumnumber=ｍｉｄ（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=4SelectCaseoptioncaseCase1IfOption6.valueThenText1text=Text1.TextCallHexsentElseText1text=Text1.TextCallASCIIsentEndIfCase2Callincorporate'将输入的十进制从机地址、命令、资料地址和资料内容兼并成字符串CallASCIIcheckCallASCIIsentCase3Callincorporate'将输入的十进制从机地址、命令、资料地址和资料内容兼并成字符串CallRTUcheckCallHexsentCase4Callincorporate1'将输入的十进制从机地址、命令、资料地址和资料内容兼并成字符串CalldeltaASCIICallASCIIsentEndSelectEndSub'十六进制发送PrivateSubHexsent()Dimhexchrlen%,HexｃｈｒAsString,hexcyc%,hexｍｉｄAsByte,hexmiddleAsStringDimhexchrgroup()AsByte,iAsIntegerhexchrlen=Len(Text1text)Forhexcyc=1Tohexchrlen'审核Text1文本框内数值能否适合Hexｃｈｒ=ｍｉｄ（Text1text,hexcyc,1)IfInStr("0123456789ABCDEFabcdef",Hexchr)=0ThenMsgBox"有效的数值，请从新输入",,"失误消息"ExitSubEndIfNextReDimhexchrgroup(1Tohexchrlen\2)AsByteForhexcyc=1TohexchrlenStep2'将文本框内数值分红两个、两个i=i+1Hexｃｈｒ=ｍｉｄ（Text1text,hexcyc,2)hexｍｉｄ=Val("&H"&CStr(Hexchr))hexchrgroup(i)=hexmid'MSComm1.Output=CStr(hexmid)NextMSComm1.Output=hexchrgroupEndSub'ASC码发送PrivateSubASCIIsent()MSComm1.Output=Text1textEndSub'ASC校验,此段程序计算出LRC校验值，并加上字头和字尾PrivateSubASCIIcheck()Dima%,b%,chrnum%,LrcbyteAsStringDimchecksum%,char%,AscLrc%,Lrc%chrnum=Len(Text1text)Fora=1TochrnumStep2ｃｈａｒ=Val("&H"&CStr(Mid(Text1text,a,2)))'两个两个的取字符checksum=checksum+char'所有加起来NextAscLrc=checksumMod&H100'取255的余数Lrc=(&HFF-AscLrc)+1'取二次补IfLrc<16Then'此段程序是判别Hex(lrc)能否是一位数，Lrcbyte="0"+CStr(Hex(Lrc))'假设是的话，前面加0；否则不加零ElseLrcbyte=CStr(Hex(Lrc))EndIfText1text=CStr(Chr(58))&CStr(Text1text)&Lrcbyte&CStr(Chr(13))&CStr(Chr(10))EndSub'DeltaASCII校验,此段程序计算出LRC校验值，并加上字头和字尾PrivateSubdeltaASCII()Dima%,b%,chrnum%,LrcbyteAsStringDimchecksum%,char%,Lrc%chrnum=Len(Text1text)Fora=1Tochrnumｃｈａｒ=Asc(Mid(Text1text,a,1))'两个两个的取字符checksum=checksum+char'所有加起来NextLrc=(checksum+&H3)Mod&H100'取255的余数IfLrc<16Then'此段程序是判别Hex(lrc)能否是一位数，Lrcbyte="0"+CStr(Hex(Lrc))'假设是的话，前面加0；否则不加零ElseLrcbyte=CStr(Hex(Lrc))EndIfText1text=CStr(Chr(2))&CStr(Text1text)&CStr(Chr(3))&LrcbyteEndSub'RTU校验PrivateSubRTUcheck()DimCRC()AsByteDimd(5)AsByteDimstring1AsStringDimjAsInteger,chrlengthAsInteger,tempAsStringstring1=Text1textchrlength=Len(string1)Forj=0Tochrlength/2-1temp=ｍｉｄ（string1,j*2+1,2)d(j)=Val("&H"&temp)NextRTUCRC=CRC16(d)'调用CRC16计算函数,CRC(0)为高位,CRC(1)为低位Text1text=Text1text&RTUCRCEndSubPrivateSubincorporate()'将输入的十进制从机地址、命令、资料地址和资料内容兼并成字符串DimwholeｃｈａｒAsString,wc%,wcyc%,wｃｈａｒAsStringDimSIDAsString,CmdAsString,InfoAddAsString,>SIDnum=Len(CStr(Hex(Combo6.Text)))SelectCaseSIDnumCase0ExitSubCase1SID="0"&CStr(Hex(Combo6.Text))Case2SID=CStr(Hex(Combo6.Text))EndSelect

Cmdnum=Len(CStr(Hex(Text6.Text)))SelectCaseCmdnumCase0ExitSubCase1Cmd="0"&CStr(Hex(Text6.Text))Case1Cmd=CStr(Hex(Text6.Text))EndSelectInfoAddNum=Len(CStr(Hex(Text7.Text)))SelectCaseInfoAddNumCase0ExitSubCase1InfoAdd="000"&CStr(Hex(Text7.Text))Case2InfoAdd="00"&CStr(Hex(Text7.Text))Case3InfoAdd="0"&CStr(Hex(Text7.Text))Case4InfoAdd=CStr(Hex(Text7.Text))EndSelect>SIDnum=Len(CStr(Hex(Combo6.Text)))SelectCaseSIDnumCase0ExitSubCase1SID="0"&CStr(Hex(Combo6.Text))Case2SID=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))'EndSelectInfoAddNum=Len(CStr(Hex(Text7.Text)))SelectCaseInfoAddNumCase0ExitSubCase1InfoAdd="0"&CStr(Hex(Text7.Text))Case2InfoAdd=CStr(Hex(Text7.Text))EndSelect>

这是工控网上另一牛人编的，我试了半天也试不进去，不过可用做大侠您参考。