VB控件Mscomm控件与PLC进行RS485Modbus通讯源码

1、V B 控件 Mscomm 控件与 PLC 进行 RS485(Modbus)通讯源码本人用的是 ModbusRTU通讯模式,通过at算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而到达自动化限制远端设备.DimHiByteAsByteDimLoByteAsByteDimCRC16LoAsByteDimCRC16HiAsByteDimReturnData(1)AsByteDimKAsIntegerDimCmdLenthAsIntegerPrivateSubCommand1_Click()K=Text9.Text6 个字节Text13.Text="",

2、=嗷组赋值输入代码'<<算法一 >>DimWriteStr()AsByteDimuAsIntegerReDimWriteStr(K+2)Foru=0ToKWriteStr(u尸Val("&H"&Text1(u).Text)Next'<<算法二>>DimCRC_2()AsByteDimvAsIntegerReDimCRC_2(K)Forv=0ToKCRC_2(v)=Val("&H"&Text1(v).Text)NextCallCRC161(CRC_2()Call

3、CRC16(WriteStr(),K)MSComm1.InBufferCount=0 = 显示发送代码DimmAsIntegerForm=0To23Ifm<=KThenText8(m).Text=Hex(WriteStr(m)ElseText8(m).Text=""EndIfNext ,WriteStr(K+1)=LoByteWriteStr(K+2)=HiByte '发送代码Text4.Text=""DimgAsIntegerForg=0ToK+2Text4.Text=Text4.Text+""+Hex(WriteSt

4、r(g) Next'写命令发送后,当接收到8个字节时中断CmdLenth=8MSComm1.RThreshold=CmdLenthMSComm1.Output=WriteStrEndSubPrivateSubCommand2_Click()EndEndSubPrivateSubCommand3_Click()Label34.Caption="="Text13.Text=""K=Text9.Text6 个字节 ,=嗷组赋值输入代码'<<算法>>DimCRC_2()AsByteDimvAsIntegerReDimCRC

5、_2(K)Forv=0ToKCRC_2(v)=Val("&H"&Text1(v).Text)Next ,CallCRC161(CRC_2()CallCRC16(WriteStr(),K)MSComm1.InBufferCount=0 '= 显示发送代码DimmAsIntegerForm=0To23Ifm<=KThenText8(m).Text=Hex(WriteStr(m)ElseText8(m).Text=""EndIfNext ,WriteStr(K+1)=LoByteWriteStr(K+2)=HiByte '

6、发送代码Text4.Text=""DimgAsIntegerForg=0ToK+2Text4.Text=Text4.Text+""+Hex(WriteStr(g) Next读命令发送后,当接收5+SendStr(5)*2个字节时产生中断CmdLenth=5+WriteStr(5)*2MSComm1.RThreshold=CmdLenthMSComm1.Output=WriteStr'发送命令'*'*'*'DimsAddrAsString ''DimCheckStringAsString'Di

7、mCheckCodeAsString'DimCmdCodeAsString'DimSumAsInteger'DimaAsInteger'DimtmpAsString'a=0'tmp=0'DoWhileLen(tmp)<8 tmp=tmp+MSComm1.Input'testNO.Caption=testNO.Caption+""+Str(Hex(Asc(tmp) 'a=a+1'Ifa>=3000Then'MSComm1.PortOpen=False 'ExitFunc

8、tion 'ExitDo 'EndIf 'Loop'Label33.Caption=tmp 'Text16.Text=Len(tmp) 'DimnsAsInteger 'Forns=1ToLen(tmp) 'Label34.Caption=Label34.Caption+"+"+Str(Asc(Mid(tmp,ns,1) ''Next'Label35.Caption=Str(Val(Asc(Mid(tmp,6,1)/10) '''tmp=Mid$(tmp,6,4)

9、 '''DimstrHexAsString 'DimHex2DecAsLong 'DimstrTmpAsString 'DimlongTmpAsLong 'DimlongDecAsLong 'DimintLenAsInteger 'Dimn1AsInteger ''strHex=Right$(tmp,2)+Left$(tmp,2) ''intLen=Len(strHex) 'Forn1=1TointLen 'strTmp=Mid(strHex,n1,1) 'Selec

10、tCaseAsc(strTmp) 'Case48To57'longTmp=Val(strTmp) 'Case65To70'longTmp=Asc(strTmp)-55 'CaseElse 'Hex2Dec=0 ''ExitFunction 'EndSelect'Text13.Text=Text13.Text+"+"+Str(Asc(strTmp)'longDec=longDec+longTmp*16A(intLen-n1) 'Nextnl ''Hex2Dec=lo

11、ngDec'Text13.Text=Hex2Dec(*(* *(* *EndSubPrivateSubMSComm1_OnComm()DimNeAsIntegerSelectCaseMSComm1.CommEventCasecomEvReceiveDimBufferAsVariantMSComm1.InputMode=comInputModeBinaryMSComm1.InputLen=0Buffer=MSComm1.InputForNe=LBound(Buffer)ToUBound(Buffer)Text13.Text=Text13.Text&"+"&am

12、p;Buffer(Ne)Label34.Caption=Buffer(3)&""&Buffer(4)NextNeCaseElseEndSelectBeepEndSubPrivateSubCommand4_Click()EndSubPrivateSubCommand5_Click()Label34.Caption="="EndSubPrivateSubForm_Load()MSComm1.Settings="9600,N,8,1MSComm1.CommPort=1MSComm1.SThreshold=0IfNotMSComm1.P

13、ortOpenThenMSComm1.PortOpen=True EndSubPrivateSubTimer1_Timer()'显示 崂法一 结果Text2.Text=Hex(HiByte)Text3.Text=Hex(LoByte)'显示 崂法二 结果Text6.Text=Hex(CRC16Hi)Text7.Text=Hex(CRC16Lo)IfText5.Text<>""Then'十进制转十六进制Text10.Text=Hex(Text5.Text)EndIfIfText11.Text<>""Then&

14、#39;十六进制转十进制Text12.Text=Val("&H"&Text11.Text)EndIfText14.Text=MSComm1.OutBufferCountEndSub'=CRO验 <<算法X>>=FunctionCRC161(data()AsByte)AsString'CRCU 算函数'DimCRC16LoAsByte,CRC16HiAsByte'CR存放器DimCLAsByte,CHAsByte多项式码 &HA001DimSaveHiAsByte,SaveLoAsByteDimI

15、AsIntegerDimFlagAsIntegerCRC16Lo=&HFFCRC16Hi=&HFFCL=&H1CH=&HA0ForI=0ToUBound(data)CRC16Lo=CRC16LoXordata(微一个数据与 CRC存放器进行异或ForFlag=0To7CRC16Hi=CRC16Hi淌位右移一位CRC16Lo=CRC16Lo2 氐位右移一位If(SaveHiAnd&H1)=&H1)Then'如果高位字节最后一位为1CRC16Lo=CRC16LoOr&H8那么低位字节右移后前面补1EndIf否那么自动补0If(SaveLoAnd&H1)=&H1)Then'如果LSB为1,那么与多项式码进行异或CRC16Hi=CRC16HiXorCHCRC