V B控件M s c o m m控件与P L C进行R S M o d b u s通讯源码集团企业公司编码：（LL3698-KKI1269-TM2483-LUI12689-ITT289-V B控件M s c o m m控件与P L C进行R S485(M o d b u s)通讯源码本人用的是ModbusRTU通讯模式，通过计算机串口转RS485与外围设备通行通讯，读写外围设备指定地址里的数据，从而达到自动化控制远端设备。

DimHiByteAsByteDimLoByteAsByteDimCRC16LoAsByteDimCRC16HiAsByteDimReturnData(1)AsByteDimKAsIntegerDimCmdLenthAsIntegerPrivateSubCommand1_Click()K=Text9.Text'写6个字节Text13.Text=""'===========数组赋值输入代码=============================================================== ========================'<<算法一>>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)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'发送代码Text4.Text=""DimgAsIntegerForg=0ToK+2Text4.Text=Text4.Text+""+Hex(WriteStr(g))Next'写命令发送后,当接收到8个字节时中断CmdLenth=8MSComm1.RThreshold=CmdLenthMSComm1.Output=WriteStrEndSubPrivateSubCommand2_Click()EndEndSubPrivateSubCommand3_Click()Label34.Caption="="Text13.Text=""K=Text9.Text'写6个字节'===========数组赋值输入代码=============================================================== ========================'<<算法>>DimCRC_2()AsByteDimvAsIntegerReDimCRC_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'发送代码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'DimCheckCodeAsString'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'ExitFunction'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)'''DimstrHexAsString'DimHex2DecAsLong'DimstrTmpAsString'DimlongTmpAsLong'DimlongDecAsLong'DimintLenAsInteger'Dimn1AsInteger''strHex=Right$(tmp,2)+Left$(tmp,2) ''intLen=Len(strHex)'Forn1=1TointLen'strTmp=Mid(strHex,n1,1)'SelectCaseAsc(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*16^(intLen-n1)'Nextn1''Hex2Dec=longDec'Text13.Text=Hex2Dec'************************************************************** *************************************************************** ***********'************************************************************** *****************************************************'************************************************************** *************************************************************** ***********EndSubPrivateSubMSComm1_OnComm()DimNeAsIntegermEventCasecomEvReceiveDimBufferAsVariantMSComm1.InputMode=comInputModeBinaryMSComm1.InputLen=0Buffer=MSComm1.InputForNe=LBound(Buffer)ToUBound(Buffer)Text13.Text=Text13.Text&"+"&Buffer(Ne)Label34.Caption=Buffer(3)&""&Buffer(4)NextNeCaseElseEndSelectBeepEndSubPrivateSubCommand4_Click()EndSubPrivateSubCommand5_Click()Label34.Caption="="EndSubPrivateSubForm_Load()MSComm1.Settings="9600,N,8,1"mPort=1MSComm1.SThreshold=0IfNotMSComm1.PortOpenThenMSComm1.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'十六进制转十进制Text12.Text=Val("&H"&Text11.Text)EndIfText14.Text=MSComm1.OutBufferCountEndSub'==========CRC校验<<算法二>>=========================================================== =============================FunctionCRC161(data()AsByte)AsString'CRC计算函数'DimCRC16LoAsByte,CRC16HiAsByte'CRC寄存器DimCLAsByte,CHAsByte'多项式码&HA001DimSaveHiAsByte,SaveLoAsByteDimIAsIntegerDimFlagAsIntegerCRC16Lo=&HFFCRC16Hi=&HFFCL=&H1CH=&HA0ForI=0ToUBound(data)CRC16Lo=CRC16LoXordata(I)'每一个数据与CRC寄存器进行异或ForFlag=0To7CRC16Hi=CRC16Hi\2'高位右移一位CRC16Lo=CRC16Lo\2'低位右移一位If((SaveHiAnd&H1)=&H1)Then'如果高位字节最后一位为1CRC16Lo=CRC16LoOr&H80'则低位字节右移后前面补1EndIf'否则自动补0If((SaveLoAnd&H1)=&H1)Then'如果LSB为1，则与多项式码进行异或CRC16Hi=CRC16HiXorCHCRC16Lo=CRC16LoXorCLEndIfNextFlagNextIDimReturnData(1)AsByteReturnData(0)=CRC16Hi'CRC高位ReturnData(1)=CRC16Lo'CRC低位asd=Right("00"+Hex(CRC16Lo),2)+Right("00"+Hex(CRC16Hi),2) EndFunctionPrivateSubmscomm_OnComm()EndSub。