Modbus 通讯协议编程.doc

Modbus通讯协议编程本人最近为了实现电脑与DeltaVFD-M变频器通讯，特意用VB6.0编了一个Modbus协议通讯软件，不过这只是一个测试版，但Modbus的ASCii协议和RTU协议都已经实现。现在将源程序上贴，希望可以帮助到有需要的朋友，谢谢！(我发现图片贴不上去）另外，假如你觉得有更好的想法，欢迎E-mail指教。附：VB6源程序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,错误信息ExitSubEndIfEndSub10转16进制PrivateSubCommand2_Click(IndexAsInteger)OnErrorResumeNextText4.Text=Hex(Text3.Text)IfErrThen则显示出错信息MsgBoxError$,48,错误信息ExitSubEndIfEndSub16转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)&25MSComm1.Settings=9600,N,7,2MSComm1.PortOpen=TrueMSComm1.Output=STPMSComm1.PortOpen=FalseIfErrThen打开串口失败，则显示出错信息MsgBoxError$,48,错误信息ExitSubEndIfEndSubPrivateSubCommand8_Click()OnErrorResumeNextDimFWDAsStringFWD=CStr(Chr(2)&010101&CStr(Chr(3)&26MSComm1.Settings=9600,N,7,2MSComm1.PortOpen=TrueMSComm1.Output=FWDMSComm1.PortOpen=FalseIfErrThen打开串口失败，则显示出错信息MsgBoxError$,48,错误信息ExitSubEndIfEndSubPrivateSubCommand9_Click()OnErrorResumeNextDimREVAsStringREV=CStr(Chr(2)&010201&CStr(Chr(3)&27MSComm1.Settings=9600,N,7,2MSComm1.PortOpen=TrueMSComm1.Output=REVMSComm1.PortOpen=FalseIfErrThen打开串口失败，则显示出错信息MsgBoxError$,48,错误信息ExitSubEndIfEndSub窗口加载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=5Combo4.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=TrueOption7.value=TrueOption9.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=FalseEndIfEndSubDeltaASCII发送协议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=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=4SelectCaseoptioncaseCase1IfOption6.valueThenText1text=Text1.TextCallHexsentElseText1text=Text1.TextCallASCIIsentEndIfCase2Callincorporate将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串CallASCIIcheckCallASCIIsentCase3Callincorporate将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串CallRTUcheckCallHexsentCase4Callincorporate1将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串CalldeltaASCIICallASCIIsentEndSelectEndSub十六进制发送PrivateSubHexsent()Dimhexchrlen%,HexchrAsString,hexcyc%,hexmidAsByte,hexmiddleAsStringDimhexchrgroup()AsByte,iAsIntegerhexchrlen=Len(Text1text)Forhexcyc=1Tohexchrlen检查Text1文本框内数值是否合适Hexchr=Mid(Text1text,hexcyc,1)IfInStr(0123456789ABCDEFabcdef,Hexchr)=0ThenMsgBox无效的数值，请重新输入,错误信息ExitSubEndIfNextReDimhexchrgroup(1Tohexchrlen2)AsByteForhexcyc=1TohexchrlenStep2将文本框内数值分成两个、两个i=i+1Hexchr=Mid(Text1text,hexcyc,2)hexmid=Val(&H&CStr(Hexchr)hexchrgroup(i)=hexmidMSComm1.Output=CStr(hexmid)NextMSComm1.Output=hexchrgroupEndSubASC码发送PrivateSubASCIIsent()MSComm1.Output=Text1textEndSubASC校验,此段程序计算出LRC校验值，并加上字头和字尾PrivateSubASCIIcheck()Dima%,b%,chrnum%,LrcbyteAsStringDimchecksum%,char%,AscLrc%,Lrc%chrnum=Len(Text1text)Fora=1TochrnumStep2char=Val(&H&CStr(Mid(Text1text,a,2)两个两个的取字符checksum=checksum+char全部加起来NextAscLrc=checksumMod&H100取255的余数Lrc=(&HFF-AscLrc)+1取二次补IfLrc16Then此段程序是判断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)EndSubDeltaASCII校验,此段程序计算出LRC校验值，并加上字头和字尾PrivateSubdeltaASCII()Dima%,b%,chrnum%,LrcbyteAsStringDimchecksum%,char%,Lrc%chrnum=Len(Text1text)Fora=1Tochrnumchar=Asc(Mid(Text1text,a,1)两个两个的取字符checksum=checksum+char全部加起来NextLrc=(checksum+&H3)Mod&H100取255的余数IfLrc16Then此段程序是判断Hex(lrc)是否是一位数，Lrcbyte=0+CStr(Hex(Lrc)如果是的话，前面加0；否则不加零ElseLrcbyte=CStr(Hex(Lrc)EndIfText1text=CStr(Chr(2)&CStr(Text1text)&CStr(Chr(3)&LrcbyteEndSubRTU校验PrivateSubRTUcheck()DimCRC()AsByteDimd(5)AsByteDimstring1AsStringDimjAsInteger,chrlengthAsInteger,tempAsStringstring1=Text1textchrlength=Len(string1)Forj=0Tochrlength/2-1temp=Mid(string1,j*2+1,2)d(j)=Val(&H&temp)NextRTUCRC=CRC16(d)调用CRC16计算函数,CRC(0)为高位,CRC(1)为低位Text1text=Text1text&RTUCRCEndSubPrivateSubincorporate()将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串DimwholecharAsString,wc%,wcyc%,wcharAsStringDimSIDAsString,CmdAsString,InfoAddAsString,dataAsStringDimSIDnum%,Cmdnum%,InfoAddNum%,Datanum%OnErrorResumeNextwholechar=CStr(Combo6.Text)&CStr(Text6.Text)&CStr(Text7.Text)&CStr(Text8.Text)wc=Len(wholechar)Forwcyc=1Towcwchar=Mid(wholechar,wcyc,1)IfInStr(0123456789,wchar)=0ThenMsgBox输入错误，请重新输入,错误提示ExitSubEndIfNextSIDnum=Len(CStr(Hex(Combo6.Text)SelectCaseSIDnumCase0ExitSubCase1SID=0&CStr(Hex(Combo6.Text)Case2SID=CStr(Hex(Combo6.Text)EndSelectCmdnum=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)EndSelectDatanum=Len(CStr(Hex(Text8.Text)SelectCaseDatanumCase0ExitSubCase1data=000&CStr(Hex(Text8.Text)Case2data=00&CStr(Hex(Text8.Text)Case3data=0&CStr(Hex(Text8.Text)Case4data=CStr(Hex(Text8.Text)EndSelectIfErrThen显示出错信息MsgBoxError$,48,错误信息ExitSubEndIfText1text=CStr(SID)&CStr(Cmd)&CStr(InfoAdd)&CStr(data)EndSubPrivateSubincorporate1()将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串DimwholecharAsString,wc%,wcyc%,wcharAsStringDimSIDAsString,CmdAsString,InfoAddAsString,dataAsStringDimSIDnum%,Cmdnum%,InfoAddNum%,Datanum%OnErrorResumeNextwholechar=CStr(Combo6.Text)&CStr(Text7.Text)&CStr(Text8.Text)wc=Len(wholechar)Forwcyc=1Towcwchar=Mid(wholechar,wcyc,1)IfInStr(0123456789,wchar)=0ThenMsgBox输入错误，请重新输入,错误提示ExitSubEndIfNextSIDnum=Len(CStr(Hex(Combo6.Text)SelectCaseSIDnumCase